{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Drawing.Common where

import GHC.Generics (Generic)

import Control.Arrow (first)
#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens.TH
#endif
import Control.Monad (join)
import Control.Monad.Fail (MonadFail)
import Control.DeepSeq (NFData)
import Data.Default
import Data.Maybe (catMaybes, listToMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as T
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Writer.Internal

-- | This simple type represents an angle in 60,000ths of a degree.
-- Positive angles are clockwise (i.e., towards the positive y axis); negative
-- angles are counter-clockwise (i.e., towards the negative y axis).
newtype Angle =
  Angle Int
  deriving (Angle -> Angle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Angle -> Angle -> Bool
$c/= :: Angle -> Angle -> Bool
== :: Angle -> Angle -> Bool
$c== :: Angle -> Angle -> Bool
Eq, Int -> Angle -> ShowS
[Angle] -> ShowS
Angle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Angle] -> ShowS
$cshowList :: [Angle] -> ShowS
show :: Angle -> String
$cshow :: Angle -> String
showsPrec :: Int -> Angle -> ShowS
$cshowsPrec :: Int -> Angle -> ShowS
Show, forall x. Rep Angle x -> Angle
forall x. Angle -> Rep Angle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Angle x -> Angle
$cfrom :: forall x. Angle -> Rep Angle x
Generic)
instance NFData Angle

-- | A string with rich text formatting
--
-- TODO: horzOverflow, lIns, tIns, rIns, bIns, numCol, spcCol, rtlCol,
--   fromWordArt, forceAA, upright, compatLnSpc, prstTxWarp,
--   a_EG_TextAutofit, scene3d, a_EG_Text3D, extLst
--
-- See @CT_TextBody@ (p. 4034)
data TextBody = TextBody
  { TextBody -> Angle
_txbdRotation :: Angle
    -- ^ Specifies the rotation that is being applied to the text within the bounding box.
  , TextBody -> Bool
_txbdSpcFirstLastPara :: Bool
    -- ^ Specifies whether the before and after paragraph spacing defined by the user is
    -- to be respected.
  , TextBody -> TextVertOverflow
_txbdVertOverflow :: TextVertOverflow
    -- ^ Determines whether the text can flow out of the bounding box vertically.
  , TextBody -> TextVertical
_txbdVertical :: TextVertical
    -- ^ Determines if the text within the given text body should be displayed vertically.
  , TextBody -> TextWrap
_txbdWrap :: TextWrap
    -- ^ Specifies the wrapping options to be used for this text body.
  , TextBody -> TextAnchoring
_txbdAnchor :: TextAnchoring
    -- ^ Specifies the anchoring position of the txBody within the shape.
  , TextBody -> Bool
_txbdAnchorCenter :: Bool
    -- ^ Specifies the centering of the text box. The way it works fundamentally is
    -- to determine the smallest possible "bounds box" for the text and then to center
    -- that "bounds box" accordingly. This is different than paragraph alignment, which
    -- aligns the text within the "bounds box" for the text.
  , TextBody -> [TextParagraph]
_txbdParagraphs :: [TextParagraph]
    -- ^ Paragraphs of text within the containing text body
  } deriving (TextBody -> TextBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextBody -> TextBody -> Bool
$c/= :: TextBody -> TextBody -> Bool
== :: TextBody -> TextBody -> Bool
$c== :: TextBody -> TextBody -> Bool
Eq, Int -> TextBody -> ShowS
[TextBody] -> ShowS
TextBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextBody] -> ShowS
$cshowList :: [TextBody] -> ShowS
show :: TextBody -> String
$cshow :: TextBody -> String
showsPrec :: Int -> TextBody -> ShowS
$cshowsPrec :: Int -> TextBody -> ShowS
Show, forall x. Rep TextBody x -> TextBody
forall x. TextBody -> Rep TextBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextBody x -> TextBody
$cfrom :: forall x. TextBody -> Rep TextBody x
Generic)
instance NFData TextBody


-- | Text vertical overflow
-- See 20.1.10.83 "ST_TextVertOverflowType (Text Vertical Overflow)" (p. 3083)
data TextVertOverflow
  = TextVertOverflowClip
    -- ^ Pay attention to top and bottom barriers. Provide no indication that there is
    -- text which is not visible.
  | TextVertOverflowEllipsis
    -- ^ Pay attention to top and bottom barriers. Use an ellipsis to denote that
    -- there is text which is not visible.
  | TextVertOverflow
    -- ^ Overflow the text and pay no attention to top and bottom barriers.
  deriving (TextVertOverflow -> TextVertOverflow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextVertOverflow -> TextVertOverflow -> Bool
$c/= :: TextVertOverflow -> TextVertOverflow -> Bool
== :: TextVertOverflow -> TextVertOverflow -> Bool
$c== :: TextVertOverflow -> TextVertOverflow -> Bool
Eq, Int -> TextVertOverflow -> ShowS
[TextVertOverflow] -> ShowS
TextVertOverflow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextVertOverflow] -> ShowS
$cshowList :: [TextVertOverflow] -> ShowS
show :: TextVertOverflow -> String
$cshow :: TextVertOverflow -> String
showsPrec :: Int -> TextVertOverflow -> ShowS
$cshowsPrec :: Int -> TextVertOverflow -> ShowS
Show, forall x. Rep TextVertOverflow x -> TextVertOverflow
forall x. TextVertOverflow -> Rep TextVertOverflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextVertOverflow x -> TextVertOverflow
$cfrom :: forall x. TextVertOverflow -> Rep TextVertOverflow x
Generic)
instance NFData TextVertOverflow

-- | If there is vertical text, determines what kind of vertical text is going to be used.
--
--  See 20.1.10.82 "ST_TextVerticalType (Vertical Text Types)" (p. 3083)
data TextVertical
  = TextVerticalEA
    -- ^ A special version of vertical text, where some fonts are displayed as if rotated
    -- by 90 degrees while some fonts (mostly East Asian) are displayed vertical.
  | TextVerticalHorz
    -- ^ Horizontal text. This should be default.
  | TextVerticalMongolian
    -- ^ A special version of vertical text, where some fonts are displayed as if rotated
    -- by 90 degrees while some fonts (mostly East Asian) are displayed vertical. The
    -- difference between this and the 'TextVerticalEA' is the text flows top down then
    -- LEFT RIGHT, instead of RIGHT LEFT
  | TextVertical
    -- ^ Determines if all of the text is vertical orientation (each line is 90 degrees
    -- rotated clockwise, so it goes from top to bottom; each next line is to the left
    -- from the previous one).
  | TextVertical270
    -- ^ Determines if all of the text is vertical orientation (each line is 270 degrees
    -- rotated clockwise, so it goes from bottom to top; each next line is to the right
    -- from the previous one).
  | TextVerticalWordArt
    -- ^ Determines if all of the text is vertical ("one letter on top of another").
  | TextVerticalWordArtRtl
    -- ^  Specifies that vertical WordArt should be shown from right to left rather than
    -- left to right.
  deriving (TextVertical -> TextVertical -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextVertical -> TextVertical -> Bool
$c/= :: TextVertical -> TextVertical -> Bool
== :: TextVertical -> TextVertical -> Bool
$c== :: TextVertical -> TextVertical -> Bool
Eq, Int -> TextVertical -> ShowS
[TextVertical] -> ShowS
TextVertical -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextVertical] -> ShowS
$cshowList :: [TextVertical] -> ShowS
show :: TextVertical -> String
$cshow :: TextVertical -> String
showsPrec :: Int -> TextVertical -> ShowS
$cshowsPrec :: Int -> TextVertical -> ShowS
Show, forall x. Rep TextVertical x -> TextVertical
forall x. TextVertical -> Rep TextVertical x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextVertical x -> TextVertical
$cfrom :: forall x. TextVertical -> Rep TextVertical x
Generic)
instance NFData TextVertical

-- | Text wrapping types
--
-- See 20.1.10.84 "ST_TextWrappingType (Text Wrapping Types)" (p. 3084)
data TextWrap
    = TextWrapNone
    -- ^ No wrapping occurs on this text body. Words spill out without
    -- paying attention to the bounding rectangle boundaries.
    | TextWrapSquare
    -- ^ Determines whether we wrap words within the bounding rectangle.
    deriving (TextWrap -> TextWrap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextWrap -> TextWrap -> Bool
$c/= :: TextWrap -> TextWrap -> Bool
== :: TextWrap -> TextWrap -> Bool
$c== :: TextWrap -> TextWrap -> Bool
Eq, Int -> TextWrap -> ShowS
[TextWrap] -> ShowS
TextWrap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextWrap] -> ShowS
$cshowList :: [TextWrap] -> ShowS
show :: TextWrap -> String
$cshow :: TextWrap -> String
showsPrec :: Int -> TextWrap -> ShowS
$cshowsPrec :: Int -> TextWrap -> ShowS
Show, forall x. Rep TextWrap x -> TextWrap
forall x. TextWrap -> Rep TextWrap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextWrap x -> TextWrap
$cfrom :: forall x. TextWrap -> Rep TextWrap x
Generic)
instance NFData TextWrap

-- | This type specifies a list of available anchoring types for text.
--
-- See 20.1.10.59 "ST_TextAnchoringType (Text Anchoring Types)" (p. 3058)
data TextAnchoring
  = TextAnchoringBottom
    -- ^ Anchor the text at the bottom of the bounding rectangle.
  | TextAnchoringCenter
    -- ^ Anchor the text at the middle of the bounding rectangle.
  | TextAnchoringDistributed
    -- ^  Anchor the text so that it is distributed vertically. When text is horizontal,
    -- this spaces out the actual lines of text and is almost always identical in
    -- behavior to 'TextAnchoringJustified' (special case: if only 1 line, then anchored
    -- in middle). When text is vertical, then it distributes the letters vertically.
    -- This is different than 'TextAnchoringJustified', because it always forces distribution
    -- of the words, even if there are only one or two words in a line.
  | TextAnchoringJustified
    -- ^ Anchor the text so that it is justified vertically. When text is horizontal,
    -- this spaces out the actual lines of text and is almost always identical in
    -- behavior to 'TextAnchoringDistributed' (special case: if only 1 line, then anchored at
    -- top). When text is vertical, then it justifies the letters vertically. This is
    -- different than 'TextAnchoringDistributed' because in some cases such as very little
    -- text in a line, it does not justify.
  | TextAnchoringTop
    -- ^ Anchor the text at the top of the bounding rectangle.
  deriving (TextAnchoring -> TextAnchoring -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextAnchoring -> TextAnchoring -> Bool
$c/= :: TextAnchoring -> TextAnchoring -> Bool
== :: TextAnchoring -> TextAnchoring -> Bool
$c== :: TextAnchoring -> TextAnchoring -> Bool
Eq, Int -> TextAnchoring -> ShowS
[TextAnchoring] -> ShowS
TextAnchoring -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextAnchoring] -> ShowS
$cshowList :: [TextAnchoring] -> ShowS
show :: TextAnchoring -> String
$cshow :: TextAnchoring -> String
showsPrec :: Int -> TextAnchoring -> ShowS
$cshowsPrec :: Int -> TextAnchoring -> ShowS
Show, forall x. Rep TextAnchoring x -> TextAnchoring
forall x. TextAnchoring -> Rep TextAnchoring x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextAnchoring x -> TextAnchoring
$cfrom :: forall x. TextAnchoring -> Rep TextAnchoring x
Generic)
instance NFData TextAnchoring

-- See 21.1.2.2.6 "p (Text Paragraphs)" (p. 3211)
data TextParagraph = TextParagraph
  { TextParagraph -> Maybe TextCharacterProperties
_txpaDefCharProps :: Maybe TextCharacterProperties
  , TextParagraph -> [TextRun]
_txpaRuns :: [TextRun]
  } deriving (TextParagraph -> TextParagraph -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextParagraph -> TextParagraph -> Bool
$c/= :: TextParagraph -> TextParagraph -> Bool
== :: TextParagraph -> TextParagraph -> Bool
$c== :: TextParagraph -> TextParagraph -> Bool
Eq, Int -> TextParagraph -> ShowS
[TextParagraph] -> ShowS
TextParagraph -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextParagraph] -> ShowS
$cshowList :: [TextParagraph] -> ShowS
show :: TextParagraph -> String
$cshow :: TextParagraph -> String
showsPrec :: Int -> TextParagraph -> ShowS
$cshowsPrec :: Int -> TextParagraph -> ShowS
Show, forall x. Rep TextParagraph x -> TextParagraph
forall x. TextParagraph -> Rep TextParagraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextParagraph x -> TextParagraph
$cfrom :: forall x. TextParagraph -> Rep TextParagraph x
Generic)
instance NFData TextParagraph

-- | Text character properties
--
-- TODO: kumimoji, lang, altLang, sz, strike, kern, cap, spc,
--   normalizeH, baseline, noProof, dirty, err, smtClean, smtId,
--   bmk, ln, a_EG_FillProperties, a_EG_EffectProperties, highlight,
--   a_EG_TextUnderlineLine, a_EG_TextUnderlineFill, latin, ea, cs,
--   sym, hlinkClick, hlinkMouseOver, rtl, extLst
--
-- See @CT_TextCharacterProperties@ (p. 4039)
data TextCharacterProperties = TextCharacterProperties
  { TextCharacterProperties -> Bool
_txchBold :: Bool
  , TextCharacterProperties -> Bool
_txchItalic :: Bool
  , TextCharacterProperties -> Bool
_txchUnderline :: Bool
  } deriving (TextCharacterProperties -> TextCharacterProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCharacterProperties -> TextCharacterProperties -> Bool
$c/= :: TextCharacterProperties -> TextCharacterProperties -> Bool
== :: TextCharacterProperties -> TextCharacterProperties -> Bool
$c== :: TextCharacterProperties -> TextCharacterProperties -> Bool
Eq, Int -> TextCharacterProperties -> ShowS
[TextCharacterProperties] -> ShowS
TextCharacterProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCharacterProperties] -> ShowS
$cshowList :: [TextCharacterProperties] -> ShowS
show :: TextCharacterProperties -> String
$cshow :: TextCharacterProperties -> String
showsPrec :: Int -> TextCharacterProperties -> ShowS
$cshowsPrec :: Int -> TextCharacterProperties -> ShowS
Show, forall x. Rep TextCharacterProperties x -> TextCharacterProperties
forall x. TextCharacterProperties -> Rep TextCharacterProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextCharacterProperties x -> TextCharacterProperties
$cfrom :: forall x. TextCharacterProperties -> Rep TextCharacterProperties x
Generic)
instance NFData TextCharacterProperties

-- | Text run
--
-- TODO: br, fld
data TextRun = RegularRun
  { TextRun -> Maybe TextCharacterProperties
_txrCharProps :: Maybe TextCharacterProperties
  , TextRun -> Text
_txrText :: Text
  } deriving (TextRun -> TextRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextRun -> TextRun -> Bool
$c/= :: TextRun -> TextRun -> Bool
== :: TextRun -> TextRun -> Bool
$c== :: TextRun -> TextRun -> Bool
Eq, Int -> TextRun -> ShowS
[TextRun] -> ShowS
TextRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextRun] -> ShowS
$cshowList :: [TextRun] -> ShowS
show :: TextRun -> String
$cshow :: TextRun -> String
showsPrec :: Int -> TextRun -> ShowS
$cshowsPrec :: Int -> TextRun -> ShowS
Show, forall x. Rep TextRun x -> TextRun
forall x. TextRun -> Rep TextRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextRun x -> TextRun
$cfrom :: forall x. TextRun -> Rep TextRun x
Generic)
instance NFData TextRun

-- | This simple type represents a one dimensional position or length
--
-- See 20.1.10.16 "ST_Coordinate (Coordinate)" (p. 2921)
data Coordinate
  = UnqCoordinate Int
    -- ^ see 20.1.10.19 "ST_CoordinateUnqualified (Coordinate)" (p. 2922)
  | UniversalMeasure UnitIdentifier
                     Double
    -- ^ see 22.9.2.15 "ST_UniversalMeasure (Universal Measurement)" (p. 3793)
  deriving (Coordinate -> Coordinate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coordinate -> Coordinate -> Bool
$c/= :: Coordinate -> Coordinate -> Bool
== :: Coordinate -> Coordinate -> Bool
$c== :: Coordinate -> Coordinate -> Bool
Eq, Int -> Coordinate -> ShowS
[Coordinate] -> ShowS
Coordinate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coordinate] -> ShowS
$cshowList :: [Coordinate] -> ShowS
show :: Coordinate -> String
$cshow :: Coordinate -> String
showsPrec :: Int -> Coordinate -> ShowS
$cshowsPrec :: Int -> Coordinate -> ShowS
Show, forall x. Rep Coordinate x -> Coordinate
forall x. Coordinate -> Rep Coordinate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Coordinate x -> Coordinate
$cfrom :: forall x. Coordinate -> Rep Coordinate x
Generic)
instance NFData Coordinate

-- | Units used in "Universal measure" coordinates
-- see 22.9.2.15 "ST_UniversalMeasure (Universal Measurement)" (p. 3793)
data UnitIdentifier
  = UnitCm -- "cm" As defined in ISO 31.
  | UnitMm -- "mm" As defined in ISO 31.
  | UnitIn -- "in" 1 in = 2.54 cm (informative)
  | UnitPt -- "pt" 1 pt = 1/72 in (informative)
  | UnitPc -- "pc" 1 pc = 12 pt (informative)
  | UnitPi -- "pi" 1 pi = 12 pt (informative)
  deriving (UnitIdentifier -> UnitIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnitIdentifier -> UnitIdentifier -> Bool
$c/= :: UnitIdentifier -> UnitIdentifier -> Bool
== :: UnitIdentifier -> UnitIdentifier -> Bool
$c== :: UnitIdentifier -> UnitIdentifier -> Bool
Eq, Int -> UnitIdentifier -> ShowS
[UnitIdentifier] -> ShowS
UnitIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitIdentifier] -> ShowS
$cshowList :: [UnitIdentifier] -> ShowS
show :: UnitIdentifier -> String
$cshow :: UnitIdentifier -> String
showsPrec :: Int -> UnitIdentifier -> ShowS
$cshowsPrec :: Int -> UnitIdentifier -> ShowS
Show, forall x. Rep UnitIdentifier x -> UnitIdentifier
forall x. UnitIdentifier -> Rep UnitIdentifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnitIdentifier x -> UnitIdentifier
$cfrom :: forall x. UnitIdentifier -> Rep UnitIdentifier x
Generic)
instance NFData UnitIdentifier

-- See @CT_Point2D@ (p. 3989)
data Point2D = Point2D
  { Point2D -> Coordinate
_pt2dX :: Coordinate
  , Point2D -> Coordinate
_pt2dY :: Coordinate
  } deriving (Point2D -> Point2D -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point2D -> Point2D -> Bool
$c/= :: Point2D -> Point2D -> Bool
== :: Point2D -> Point2D -> Bool
$c== :: Point2D -> Point2D -> Bool
Eq, Int -> Point2D -> ShowS
[Point2D] -> ShowS
Point2D -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point2D] -> ShowS
$cshowList :: [Point2D] -> ShowS
show :: Point2D -> String
$cshow :: Point2D -> String
showsPrec :: Int -> Point2D -> ShowS
$cshowsPrec :: Int -> Point2D -> ShowS
Show, forall x. Rep Point2D x -> Point2D
forall x. Point2D -> Rep Point2D x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Point2D x -> Point2D
$cfrom :: forall x. Point2D -> Rep Point2D x
Generic)
instance NFData Point2D

unqPoint2D :: Int -> Int -> Point2D
unqPoint2D :: Int -> Int -> Point2D
unqPoint2D Int
x Int
y = Coordinate -> Coordinate -> Point2D
Point2D (Int -> Coordinate
UnqCoordinate Int
x) (Int -> Coordinate
UnqCoordinate Int
y)

-- | Positive position or length in EMUs, maximu allowed value is 27273042316900.
-- see 20.1.10.41 "ST_PositiveCoordinate (Positive Coordinate)" (p. 2942)
newtype PositiveCoordinate =
  PositiveCoordinate Integer
  deriving (PositiveCoordinate -> PositiveCoordinate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositiveCoordinate -> PositiveCoordinate -> Bool
$c/= :: PositiveCoordinate -> PositiveCoordinate -> Bool
== :: PositiveCoordinate -> PositiveCoordinate -> Bool
$c== :: PositiveCoordinate -> PositiveCoordinate -> Bool
Eq, Eq PositiveCoordinate
PositiveCoordinate -> PositiveCoordinate -> Bool
PositiveCoordinate -> PositiveCoordinate -> Ordering
PositiveCoordinate -> PositiveCoordinate -> PositiveCoordinate
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 :: PositiveCoordinate -> PositiveCoordinate -> PositiveCoordinate
$cmin :: PositiveCoordinate -> PositiveCoordinate -> PositiveCoordinate
max :: PositiveCoordinate -> PositiveCoordinate -> PositiveCoordinate
$cmax :: PositiveCoordinate -> PositiveCoordinate -> PositiveCoordinate
>= :: PositiveCoordinate -> PositiveCoordinate -> Bool
$c>= :: PositiveCoordinate -> PositiveCoordinate -> Bool
> :: PositiveCoordinate -> PositiveCoordinate -> Bool
$c> :: PositiveCoordinate -> PositiveCoordinate -> Bool
<= :: PositiveCoordinate -> PositiveCoordinate -> Bool
$c<= :: PositiveCoordinate -> PositiveCoordinate -> Bool
< :: PositiveCoordinate -> PositiveCoordinate -> Bool
$c< :: PositiveCoordinate -> PositiveCoordinate -> Bool
compare :: PositiveCoordinate -> PositiveCoordinate -> Ordering
$ccompare :: PositiveCoordinate -> PositiveCoordinate -> Ordering
Ord, Int -> PositiveCoordinate -> ShowS
[PositiveCoordinate] -> ShowS
PositiveCoordinate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositiveCoordinate] -> ShowS
$cshowList :: [PositiveCoordinate] -> ShowS
show :: PositiveCoordinate -> String
$cshow :: PositiveCoordinate -> String
showsPrec :: Int -> PositiveCoordinate -> ShowS
$cshowsPrec :: Int -> PositiveCoordinate -> ShowS
Show, forall x. Rep PositiveCoordinate x -> PositiveCoordinate
forall x. PositiveCoordinate -> Rep PositiveCoordinate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PositiveCoordinate x -> PositiveCoordinate
$cfrom :: forall x. PositiveCoordinate -> Rep PositiveCoordinate x
Generic)
instance NFData PositiveCoordinate

data PositiveSize2D = PositiveSize2D
  { PositiveSize2D -> PositiveCoordinate
_ps2dX :: PositiveCoordinate
  , PositiveSize2D -> PositiveCoordinate
_ps2dY :: PositiveCoordinate
  } deriving (PositiveSize2D -> PositiveSize2D -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositiveSize2D -> PositiveSize2D -> Bool
$c/= :: PositiveSize2D -> PositiveSize2D -> Bool
== :: PositiveSize2D -> PositiveSize2D -> Bool
$c== :: PositiveSize2D -> PositiveSize2D -> Bool
Eq, Int -> PositiveSize2D -> ShowS
[PositiveSize2D] -> ShowS
PositiveSize2D -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositiveSize2D] -> ShowS
$cshowList :: [PositiveSize2D] -> ShowS
show :: PositiveSize2D -> String
$cshow :: PositiveSize2D -> String
showsPrec :: Int -> PositiveSize2D -> ShowS
$cshowsPrec :: Int -> PositiveSize2D -> ShowS
Show, forall x. Rep PositiveSize2D x -> PositiveSize2D
forall x. PositiveSize2D -> Rep PositiveSize2D x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PositiveSize2D x -> PositiveSize2D
$cfrom :: forall x. PositiveSize2D -> Rep PositiveSize2D x
Generic)
instance NFData PositiveSize2D

positiveSize2D :: Integer -> Integer -> PositiveSize2D
positiveSize2D :: Integer -> Integer -> PositiveSize2D
positiveSize2D Integer
x Integer
y =
  PositiveCoordinate -> PositiveCoordinate -> PositiveSize2D
PositiveSize2D (Integer -> PositiveCoordinate
PositiveCoordinate Integer
x) (Integer -> PositiveCoordinate
PositiveCoordinate Integer
y)

cmSize2D :: Integer -> Integer -> PositiveSize2D
cmSize2D :: Integer -> Integer -> PositiveSize2D
cmSize2D Integer
x Integer
y = Integer -> Integer -> PositiveSize2D
positiveSize2D (Integer -> Integer
cm2emu Integer
x) (Integer -> Integer
cm2emu Integer
y)

cm2emu :: Integer -> Integer
cm2emu :: Integer -> Integer
cm2emu Integer
cm = Integer
360000 forall a. Num a => a -> a -> a
* Integer
cm

-- See 20.1.7.6 "xfrm (2D Transform for Individual Objects)" (p. 2849)
data Transform2D = Transform2D
  { Transform2D -> Angle
_trRot :: Angle
    -- ^ Specifies the rotation of the Graphic Frame.
  , Transform2D -> Bool
_trFlipH :: Bool
    -- ^ Specifies a horizontal flip. When true, this attribute defines
    -- that the shape is flipped horizontally about the center of its bounding box.
  , Transform2D -> Bool
_trFlipV :: Bool
    -- ^ Specifies a vertical flip. When true, this attribute defines
    -- that the shape is flipped vetically about the center of its bounding box.
  , Transform2D -> Maybe Point2D
_trOffset :: Maybe Point2D
    -- ^ See 20.1.7.4 "off (Offset)" (p. 2847)
  , Transform2D -> Maybe PositiveSize2D
_trExtents :: Maybe PositiveSize2D
    -- ^ See 20.1.7.3 "ext (Extents)" (p. 2846) or
    -- 20.5.2.14 "ext (Shape Extent)" (p. 3165)
  } deriving (Transform2D -> Transform2D -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transform2D -> Transform2D -> Bool
$c/= :: Transform2D -> Transform2D -> Bool
== :: Transform2D -> Transform2D -> Bool
$c== :: Transform2D -> Transform2D -> Bool
Eq, Int -> Transform2D -> ShowS
[Transform2D] -> ShowS
Transform2D -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transform2D] -> ShowS
$cshowList :: [Transform2D] -> ShowS
show :: Transform2D -> String
$cshow :: Transform2D -> String
showsPrec :: Int -> Transform2D -> ShowS
$cshowsPrec :: Int -> Transform2D -> ShowS
Show, forall x. Rep Transform2D x -> Transform2D
forall x. Transform2D -> Rep Transform2D x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Transform2D x -> Transform2D
$cfrom :: forall x. Transform2D -> Rep Transform2D x
Generic)
instance NFData Transform2D

-- TODO: custGeom
data Geometry =
  PresetGeometry
  -- TODO: prst, avList
  -- currently uses "rect" with empty avList
  deriving (Geometry -> Geometry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Geometry -> Geometry -> Bool
$c/= :: Geometry -> Geometry -> Bool
== :: Geometry -> Geometry -> Bool
$c== :: Geometry -> Geometry -> Bool
Eq, Int -> Geometry -> ShowS
[Geometry] -> ShowS
Geometry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Geometry] -> ShowS
$cshowList :: [Geometry] -> ShowS
show :: Geometry -> String
$cshow :: Geometry -> String
showsPrec :: Int -> Geometry -> ShowS
$cshowsPrec :: Int -> Geometry -> ShowS
Show, forall x. Rep Geometry x -> Geometry
forall x. Geometry -> Rep Geometry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Geometry x -> Geometry
$cfrom :: forall x. Geometry -> Rep Geometry x
Generic)
instance NFData Geometry

-- See 20.1.2.2.35 "spPr (Shape Properties)" (p. 2751)
data ShapeProperties = ShapeProperties
  { ShapeProperties -> Maybe Transform2D
_spXfrm :: Maybe Transform2D
  , ShapeProperties -> Maybe Geometry
_spGeometry :: Maybe Geometry
  , ShapeProperties -> Maybe FillProperties
_spFill :: Maybe FillProperties
  , ShapeProperties -> Maybe LineProperties
_spOutline :: Maybe LineProperties
    -- TODO: bwMode, a_EG_EffectProperties, scene3d, sp3d, extLst
  } deriving (ShapeProperties -> ShapeProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeProperties -> ShapeProperties -> Bool
$c/= :: ShapeProperties -> ShapeProperties -> Bool
== :: ShapeProperties -> ShapeProperties -> Bool
$c== :: ShapeProperties -> ShapeProperties -> Bool
Eq, Int -> ShapeProperties -> ShowS
[ShapeProperties] -> ShowS
ShapeProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapeProperties] -> ShowS
$cshowList :: [ShapeProperties] -> ShowS
show :: ShapeProperties -> String
$cshow :: ShapeProperties -> String
showsPrec :: Int -> ShapeProperties -> ShowS
$cshowsPrec :: Int -> ShapeProperties -> ShowS
Show, forall x. Rep ShapeProperties x -> ShapeProperties
forall x. ShapeProperties -> Rep ShapeProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShapeProperties x -> ShapeProperties
$cfrom :: forall x. ShapeProperties -> Rep ShapeProperties x
Generic)
instance NFData ShapeProperties

-- | Specifies an outline style that can be applied to a number of
-- different objects such as shapes and text.
--
-- TODO: cap, cmpd, algn, a_EG_LineDashProperties,
--   a_EG_LineJoinProperties, headEnd, tailEnd, extLst
--
-- See 20.1.2.2.24 "ln (Outline)" (p. 2744)
data LineProperties = LineProperties
  { LineProperties -> Maybe FillProperties
_lnFill :: Maybe FillProperties
  , LineProperties -> Int
_lnWidth :: Int
  -- ^ Specifies the width to be used for the underline stroke.  The
  -- value is in EMU, is greater of equal to 0 and maximum value is
  -- 20116800.
  } deriving (LineProperties -> LineProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineProperties -> LineProperties -> Bool
$c/= :: LineProperties -> LineProperties -> Bool
== :: LineProperties -> LineProperties -> Bool
$c== :: LineProperties -> LineProperties -> Bool
Eq, Int -> LineProperties -> ShowS
[LineProperties] -> ShowS
LineProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineProperties] -> ShowS
$cshowList :: [LineProperties] -> ShowS
show :: LineProperties -> String
$cshow :: LineProperties -> String
showsPrec :: Int -> LineProperties -> ShowS
$cshowsPrec :: Int -> LineProperties -> ShowS
Show, forall x. Rep LineProperties x -> LineProperties
forall x. LineProperties -> Rep LineProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineProperties x -> LineProperties
$cfrom :: forall x. LineProperties -> Rep LineProperties x
Generic)
instance NFData LineProperties

-- | Color choice for some drawing element
--
-- TODO: scrgbClr, hslClr, sysClr, schemeClr, prstClr
--
-- See @EG_ColorChoice@ (p. 3996)
data ColorChoice =
  RgbColor Text
  -- ^ Specifies a color using the red, green, blue RGB color
  -- model. Red, green, and blue is expressed as sequence of hex
  -- digits, RRGGBB. A perceptual gamma of 2.2 is used.
  --
  -- See 20.1.2.3.32 "srgbClr (RGB Color Model - Hex Variant)" (p. 2773)
  deriving (ColorChoice -> ColorChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorChoice -> ColorChoice -> Bool
$c/= :: ColorChoice -> ColorChoice -> Bool
== :: ColorChoice -> ColorChoice -> Bool
$c== :: ColorChoice -> ColorChoice -> Bool
Eq, Int -> ColorChoice -> ShowS
[ColorChoice] -> ShowS
ColorChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorChoice] -> ShowS
$cshowList :: [ColorChoice] -> ShowS
show :: ColorChoice -> String
$cshow :: ColorChoice -> String
showsPrec :: Int -> ColorChoice -> ShowS
$cshowsPrec :: Int -> ColorChoice -> ShowS
Show, forall x. Rep ColorChoice x -> ColorChoice
forall x. ColorChoice -> Rep ColorChoice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColorChoice x -> ColorChoice
$cfrom :: forall x. ColorChoice -> Rep ColorChoice x
Generic)
instance NFData ColorChoice

-- TODO: gradFill, pattFill
data FillProperties =
  NoFill
  -- ^ See 20.1.8.44 "noFill (No Fill)" (p. 2872)
  | SolidFill (Maybe ColorChoice)
  -- ^ Solid fill
  -- See 20.1.8.54 "solidFill (Solid Fill)" (p. 2879)
  deriving (FillProperties -> FillProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillProperties -> FillProperties -> Bool
$c/= :: FillProperties -> FillProperties -> Bool
== :: FillProperties -> FillProperties -> Bool
$c== :: FillProperties -> FillProperties -> Bool
Eq, Int -> FillProperties -> ShowS
[FillProperties] -> ShowS
FillProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FillProperties] -> ShowS
$cshowList :: [FillProperties] -> ShowS
show :: FillProperties -> String
$cshow :: FillProperties -> String
showsPrec :: Int -> FillProperties -> ShowS
$cshowsPrec :: Int -> FillProperties -> ShowS
Show, forall x. Rep FillProperties x -> FillProperties
forall x. FillProperties -> Rep FillProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FillProperties x -> FillProperties
$cfrom :: forall x. FillProperties -> Rep FillProperties x
Generic)
instance NFData FillProperties

-- | solid fill with color specified by hexadecimal RGB color
solidRgb :: Text -> FillProperties
solidRgb :: Text -> FillProperties
solidRgb Text
t = Maybe ColorChoice -> FillProperties
SolidFill forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> ColorChoice
RgbColor Text
t

makeLenses ''ShapeProperties

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

instance Default ShapeProperties where
    def :: ShapeProperties
def = Maybe Transform2D
-> Maybe Geometry
-> Maybe FillProperties
-> Maybe LineProperties
-> ShapeProperties
ShapeProperties forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

instance Default LineProperties where
  def :: LineProperties
def = Maybe FillProperties -> Int -> LineProperties
LineProperties forall a. Maybe a
Nothing Int
0

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

instance FromCursor TextBody where
  fromCursor :: Cursor -> [TextBody]
fromCursor Cursor
cur = do
    Cursor
cur' <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
a_ Text
"bodyPr")
    Angle
_txbdRotation <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"rot" (Int -> Angle
Angle Int
0) Cursor
cur'
    Bool
_txbdSpcFirstLastPara <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"spcFirstLastPara" Bool
False Cursor
cur'
    TextVertOverflow
_txbdVertOverflow <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"vertOverflow" TextVertOverflow
TextVertOverflow Cursor
cur'
    TextVertical
_txbdVertical <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"vert" TextVertical
TextVerticalHorz Cursor
cur'
    TextWrap
_txbdWrap <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"wrap" TextWrap
TextWrapSquare Cursor
cur'
    TextAnchoring
_txbdAnchor <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"anchor" TextAnchoring
TextAnchoringTop Cursor
cur'
    Bool
_txbdAnchorCenter <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"anchorCtr" Bool
False Cursor
cur'
    let _txbdParagraphs :: [TextParagraph]
_txbdParagraphs = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
a_ Text
"p") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    forall (m :: * -> *) a. Monad m => a -> m a
return TextBody {Bool
[TextParagraph]
TextAnchoring
TextWrap
TextVertical
TextVertOverflow
Angle
_txbdParagraphs :: [TextParagraph]
_txbdAnchorCenter :: Bool
_txbdAnchor :: TextAnchoring
_txbdWrap :: TextWrap
_txbdVertical :: TextVertical
_txbdVertOverflow :: TextVertOverflow
_txbdSpcFirstLastPara :: Bool
_txbdRotation :: Angle
_txbdParagraphs :: [TextParagraph]
_txbdAnchorCenter :: Bool
_txbdAnchor :: TextAnchoring
_txbdWrap :: TextWrap
_txbdVertical :: TextVertical
_txbdVertOverflow :: TextVertOverflow
_txbdSpcFirstLastPara :: Bool
_txbdRotation :: Angle
..}

instance FromCursor TextParagraph where
  fromCursor :: Cursor -> [TextParagraph]
fromCursor Cursor
cur = do
    let _txpaDefCharProps :: Maybe TextCharacterProperties
_txpaDefCharProps =
          forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
          Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
a_ Text
"pPr") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
a_ Text
"defRPr")
        _txpaRuns :: [TextRun]
_txpaRuns = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
a_ Text
"r") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    forall (m :: * -> *) a. Monad m => a -> m a
return TextParagraph {[TextRun]
Maybe TextCharacterProperties
_txpaRuns :: [TextRun]
_txpaDefCharProps :: Maybe TextCharacterProperties
_txpaRuns :: [TextRun]
_txpaDefCharProps :: Maybe TextCharacterProperties
..}

instance FromCursor TextCharacterProperties where
  fromCursor :: Cursor -> [TextCharacterProperties]
fromCursor Cursor
cur = do
    Bool
_txchBold <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"b" Bool
False Cursor
cur
    Bool
_txchItalic <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"i" Bool
False Cursor
cur
    Bool
_txchUnderline <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"u" Bool
False Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return TextCharacterProperties {Bool
_txchUnderline :: Bool
_txchItalic :: Bool
_txchBold :: Bool
_txchUnderline :: Bool
_txchItalic :: Bool
_txchBold :: Bool
..}

instance FromCursor TextRun where
  fromCursor :: Cursor -> [TextRun]
fromCursor Cursor
cur = do
    Maybe TextCharacterProperties
_txrCharProps <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
a_ Text
"rPr") Cursor
cur
    Text
_txrText <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
a_ Text
"t") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    forall (m :: * -> *) a. Monad m => a -> m a
return RegularRun {Maybe TextCharacterProperties
Text
_txrText :: Text
_txrCharProps :: Maybe TextCharacterProperties
_txrText :: Text
_txrCharProps :: Maybe TextCharacterProperties
..}

-- See 20.1.10.3 "ST_Angle (Angle)" (p. 2912)
instance FromAttrVal Angle where
  fromAttrVal :: Reader Angle
fromAttrVal Text
t = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> Angle
Angle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrVal a => Reader a
fromAttrVal Text
t

-- See 20.1.10.83 "ST_TextVertOverflowType (Text Vertical Overflow)" (p. 3083)
instance FromAttrVal TextVertOverflow where
  fromAttrVal :: Reader TextVertOverflow
fromAttrVal Text
"overflow" = forall a. a -> Either String (a, Text)
readSuccess TextVertOverflow
TextVertOverflow
  fromAttrVal Text
"ellipsis" = forall a. a -> Either String (a, Text)
readSuccess TextVertOverflow
TextVertOverflowEllipsis
  fromAttrVal Text
"clip" = forall a. a -> Either String (a, Text)
readSuccess TextVertOverflow
TextVertOverflowClip
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"TextVertOverflow" Text
t

instance FromAttrVal TextVertical where
  fromAttrVal :: Reader TextVertical
fromAttrVal Text
"horz" = forall a. a -> Either String (a, Text)
readSuccess TextVertical
TextVerticalHorz
  fromAttrVal Text
"vert" = forall a. a -> Either String (a, Text)
readSuccess TextVertical
TextVertical
  fromAttrVal Text
"vert270" = forall a. a -> Either String (a, Text)
readSuccess TextVertical
TextVertical270
  fromAttrVal Text
"wordArtVert" = forall a. a -> Either String (a, Text)
readSuccess TextVertical
TextVerticalWordArt
  fromAttrVal Text
"eaVert" = forall a. a -> Either String (a, Text)
readSuccess TextVertical
TextVerticalEA
  fromAttrVal Text
"mongolianVert" = forall a. a -> Either String (a, Text)
readSuccess TextVertical
TextVerticalMongolian
  fromAttrVal Text
"wordArtVertRtl" = forall a. a -> Either String (a, Text)
readSuccess TextVertical
TextVerticalWordArtRtl
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"TextVertical" Text
t

instance FromAttrVal TextWrap where
  fromAttrVal :: Reader TextWrap
fromAttrVal Text
"none" = forall a. a -> Either String (a, Text)
readSuccess TextWrap
TextWrapNone
  fromAttrVal Text
"square" = forall a. a -> Either String (a, Text)
readSuccess TextWrap
TextWrapSquare
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"TextWrap" Text
t

-- See 20.1.10.59 "ST_TextAnchoringType (Text Anchoring Types)" (p. 3058)
instance FromAttrVal TextAnchoring where
  fromAttrVal :: Reader TextAnchoring
fromAttrVal Text
"t" = forall a. a -> Either String (a, Text)
readSuccess TextAnchoring
TextAnchoringTop
  fromAttrVal Text
"ctr" = forall a. a -> Either String (a, Text)
readSuccess TextAnchoring
TextAnchoringCenter
  fromAttrVal Text
"b" = forall a. a -> Either String (a, Text)
readSuccess TextAnchoring
TextAnchoringBottom
  fromAttrVal Text
"just" = forall a. a -> Either String (a, Text)
readSuccess TextAnchoring
TextAnchoringJustified
  fromAttrVal Text
"dist" = forall a. a -> Either String (a, Text)
readSuccess TextAnchoring
TextAnchoringDistributed
  fromAttrVal Text
t = forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"TextAnchoring" Text
t

instance FromCursor ShapeProperties where
  fromCursor :: Cursor -> [ShapeProperties]
fromCursor Cursor
cur = do
    Maybe Transform2D
_spXfrm <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
a_ Text
"xfrm") Cursor
cur
    let _spGeometry :: Maybe Geometry
_spGeometry = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
        _spFill :: Maybe FillProperties
_spFill = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [FillProperties]
fillPropsFromNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Cursor node -> node
node
    Maybe LineProperties
_spOutline <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
a_ Text
"ln") Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return ShapeProperties {Maybe FillProperties
Maybe LineProperties
Maybe Geometry
Maybe Transform2D
_spOutline :: Maybe LineProperties
_spFill :: Maybe FillProperties
_spGeometry :: Maybe Geometry
_spXfrm :: Maybe Transform2D
_spOutline :: Maybe LineProperties
_spFill :: Maybe FillProperties
_spGeometry :: Maybe Geometry
_spXfrm :: Maybe Transform2D
..}

instance FromCursor Transform2D where
    fromCursor :: Cursor -> [Transform2D]
fromCursor Cursor
cur = do
        Angle
_trRot     <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"rot" (Int -> Angle
Angle Int
0) Cursor
cur
        Bool
_trFlipH   <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"flipH" Bool
False Cursor
cur
        Bool
_trFlipV   <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"flipV" Bool
False Cursor
cur
        Maybe Point2D
_trOffset  <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
a_ Text
"off") Cursor
cur
        Maybe PositiveSize2D
_trExtents <- forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
a_ Text
"ext") Cursor
cur
        forall (m :: * -> *) a. Monad m => a -> m a
return Transform2D{Bool
Maybe PositiveSize2D
Maybe Point2D
Angle
_trExtents :: Maybe PositiveSize2D
_trOffset :: Maybe Point2D
_trFlipV :: Bool
_trFlipH :: Bool
_trRot :: Angle
_trExtents :: Maybe PositiveSize2D
_trOffset :: Maybe Point2D
_trFlipV :: Bool
_trFlipH :: Bool
_trRot :: Angle
..}

instance FromCursor Geometry where
    fromCursor :: Cursor -> [Geometry]
fromCursor = Node -> [Geometry]
geometryFromNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Cursor node -> node
node

geometryFromNode :: Node -> [Geometry]
geometryFromNode :: Node -> [Geometry]
geometryFromNode Node
n | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
a_ Text
"prstGeom" =
                         forall (m :: * -> *) a. Monad m => a -> m a
return Geometry
PresetGeometry
                   | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no matching geometry node"

instance FromCursor LineProperties where
    fromCursor :: Cursor -> [LineProperties]
fromCursor Cursor
cur = do
        let _lnFill :: Maybe FillProperties
_lnFill = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
        Int
_lnWidth <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"w" Int
0 Cursor
cur
        forall (m :: * -> *) a. Monad m => a -> m a
return LineProperties{Int
Maybe FillProperties
_lnWidth :: Int
_lnFill :: Maybe FillProperties
_lnWidth :: Int
_lnFill :: Maybe FillProperties
..}

instance FromCursor Point2D where
    fromCursor :: Cursor -> [Point2D]
fromCursor Cursor
cur = do
        Coordinate
x <- forall (m :: * -> *). MonadFail m => Text -> m Coordinate
coordinate forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"x" Cursor
cur
        Coordinate
y <- forall (m :: * -> *). MonadFail m => Text -> m Coordinate
coordinate forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"y" Cursor
cur
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Coordinate -> Coordinate -> Point2D
Point2D Coordinate
x Coordinate
y

instance FromCursor PositiveSize2D where
    fromCursor :: Cursor -> [PositiveSize2D]
fromCursor Cursor
cur = do
        PositiveCoordinate
cx <- Integer -> PositiveCoordinate
PositiveCoordinate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"cx" Cursor
cur
        PositiveCoordinate
cy <- Integer -> PositiveCoordinate
PositiveCoordinate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"cy" Cursor
cur
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PositiveCoordinate -> PositiveCoordinate -> PositiveSize2D
PositiveSize2D PositiveCoordinate
cx PositiveCoordinate
cy

instance FromCursor FillProperties where
    fromCursor :: Cursor -> [FillProperties]
fromCursor = Node -> [FillProperties]
fillPropsFromNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Cursor node -> node
node

fillPropsFromNode :: Node -> [FillProperties]
fillPropsFromNode :: Node -> [FillProperties]
fillPropsFromNode Node
n
  | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
a_ Text
"noFill" = forall (m :: * -> *) a. Monad m => a -> m a
return FillProperties
NoFill
  | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
a_ Text
"solidFill" = do
    let color :: Maybe ColorChoice
color =
          forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Node -> Cursor
fromNode Node
n forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [ColorChoice]
colorChoiceFromNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Cursor node -> node
node
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe ColorChoice -> FillProperties
SolidFill Maybe ColorChoice
color
  | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no matching line fill node"

colorChoiceFromNode :: Node -> [ColorChoice]
colorChoiceFromNode :: Node -> [ColorChoice]
colorChoiceFromNode Node
n
  | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
a_ Text
"srgbClr" = do
    Text
val <- forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"val" forall a b. (a -> b) -> a -> b
$ Node -> Cursor
fromNode Node
n
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> ColorChoice
RgbColor Text
val
  | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no matching color choice node"

coordinate :: MonadFail m => Text -> m Coordinate
coordinate :: forall (m :: * -> *). MonadFail m => Text -> m Coordinate
coordinate Text
t =  case forall a. Integral a => Reader a
T.decimal Text
t of
  Right (Int
d, Text
leftover) | Text
leftover forall a. Eq a => a -> a -> Bool
== Text
T.empty ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Coordinate
UnqCoordinate Int
d
  Either String (Int, Text)
_ ->
      case forall a. Fractional a => Reader a
T.rational Text
t of
          Right (Double
r, Text
"cm") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnitIdentifier -> Double -> Coordinate
UniversalMeasure UnitIdentifier
UnitCm Double
r
          Right (Double
r, Text
"mm") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnitIdentifier -> Double -> Coordinate
UniversalMeasure UnitIdentifier
UnitMm Double
r
          Right (Double
r, Text
"in") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnitIdentifier -> Double -> Coordinate
UniversalMeasure UnitIdentifier
UnitIn Double
r
          Right (Double
r, Text
"pt") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnitIdentifier -> Double -> Coordinate
UniversalMeasure UnitIdentifier
UnitPt Double
r
          Right (Double
r, Text
"pc") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnitIdentifier -> Double -> Coordinate
UniversalMeasure UnitIdentifier
UnitPc Double
r
          Right (Double
r, Text
"pi") -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UnitIdentifier -> Double -> Coordinate
UniversalMeasure UnitIdentifier
UnitPi Double
r
          Either String (Double, Text)
_               -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid coordinate: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t

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

instance ToElement TextBody where
  toElement :: Name -> TextBody -> Element
toElement Name
nm TextBody {Bool
[TextParagraph]
TextAnchoring
TextWrap
TextVertical
TextVertOverflow
Angle
_txbdParagraphs :: [TextParagraph]
_txbdAnchorCenter :: Bool
_txbdAnchor :: TextAnchoring
_txbdWrap :: TextWrap
_txbdVertical :: TextVertical
_txbdVertOverflow :: TextVertOverflow
_txbdSpcFirstLastPara :: Bool
_txbdRotation :: Angle
_txbdParagraphs :: TextBody -> [TextParagraph]
_txbdAnchorCenter :: TextBody -> Bool
_txbdAnchor :: TextBody -> TextAnchoring
_txbdWrap :: TextBody -> TextWrap
_txbdVertical :: TextBody -> TextVertical
_txbdVertOverflow :: TextBody -> TextVertOverflow
_txbdSpcFirstLastPara :: TextBody -> Bool
_txbdRotation :: TextBody -> Angle
..} = Name -> [Element] -> Element
elementListSimple Name
nm (Element
bodyPr forall a. a -> [a] -> [a]
: [Element]
paragraphs)
    where
      bodyPr :: Element
bodyPr = Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
a_ Text
"bodyPr") [(Name, Text)]
bodyPrAttrs
      bodyPrAttrs :: [(Name, Text)]
bodyPrAttrs =
        forall a. [Maybe a] -> [a]
catMaybes
          [ Name
"rot" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? forall a. Eq a => a -> a -> Maybe a
justNonDef (Int -> Angle
Angle Int
0) Angle
_txbdRotation
          , Name
"spcFirstLastPara" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_txbdSpcFirstLastPara
          , Name
"vertOverflow" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? forall a. Eq a => a -> a -> Maybe a
justNonDef TextVertOverflow
TextVertOverflow TextVertOverflow
_txbdVertOverflow
          , Name
"vert" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? forall a. Eq a => a -> a -> Maybe a
justNonDef TextVertical
TextVerticalHorz TextVertical
_txbdVertical
          , Name
"wrap" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? forall a. Eq a => a -> a -> Maybe a
justNonDef TextWrap
TextWrapSquare TextWrap
_txbdWrap
          , Name
"anchor" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? forall a. Eq a => a -> a -> Maybe a
justNonDef TextAnchoring
TextAnchoringTop TextAnchoring
_txbdAnchor
          , Name
"anchorCtr" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_txbdAnchorCenter
          ]
      paragraphs :: [Element]
paragraphs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"p")) [TextParagraph]
_txbdParagraphs

instance ToElement TextParagraph where
  toElement :: Name -> TextParagraph -> Element
toElement Name
nm TextParagraph {[TextRun]
Maybe TextCharacterProperties
_txpaRuns :: [TextRun]
_txpaDefCharProps :: Maybe TextCharacterProperties
_txpaRuns :: TextParagraph -> [TextRun]
_txpaDefCharProps :: TextParagraph -> Maybe TextCharacterProperties
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
    where
      elements :: [Element]
elements =
        case Maybe TextCharacterProperties
_txpaDefCharProps of
          Just TextCharacterProperties
props -> (forall {a}. ToElement a => a -> Element
defRPr TextCharacterProperties
props) forall a. a -> [a] -> [a]
: [Element]
runs
          Maybe TextCharacterProperties
Nothing -> [Element]
runs
      defRPr :: a -> Element
defRPr a
props =
        Name -> [Element] -> Element
elementListSimple (Text -> Name
a_ Text
"pPr") [forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"defRPr") a
props]
      runs :: [Element]
runs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"r")) [TextRun]
_txpaRuns

instance ToElement TextCharacterProperties where
  toElement :: Name -> TextCharacterProperties -> Element
toElement Name
nm TextCharacterProperties {Bool
_txchUnderline :: Bool
_txchItalic :: Bool
_txchBold :: Bool
_txchUnderline :: TextCharacterProperties -> Bool
_txchItalic :: TextCharacterProperties -> Bool
_txchBold :: TextCharacterProperties -> Bool
..} = Name -> [(Name, Text)] -> Element
leafElement Name
nm [(Name, Text)]
attrs
    where
      attrs :: [(Name, Text)]
attrs = [Name
"b" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Bool
_txchBold, Name
"i" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Bool
_txchItalic, Name
"u" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Bool
_txchUnderline]

instance ToElement TextRun where
  toElement :: Name -> TextRun -> Element
toElement Name
nm RegularRun {Maybe TextCharacterProperties
Text
_txrText :: Text
_txrCharProps :: Maybe TextCharacterProperties
_txrText :: TextRun -> Text
_txrCharProps :: TextRun -> Maybe TextCharacterProperties
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
    where
      elements :: [Element]
elements =
        forall a. [Maybe a] -> [a]
catMaybes
          [ forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"rPr") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TextCharacterProperties
_txrCharProps
          , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Text -> Element
elementContent (Text -> Name
a_ Text
"t") Text
_txrText
          ]

instance ToAttrVal TextVertOverflow where
  toAttrVal :: TextVertOverflow -> Text
toAttrVal TextVertOverflow
TextVertOverflow = Text
"overflow"
  toAttrVal TextVertOverflow
TextVertOverflowEllipsis = Text
"ellipsis"
  toAttrVal TextVertOverflow
TextVertOverflowClip = Text
"clip"

instance ToAttrVal TextVertical where
  toAttrVal :: TextVertical -> Text
toAttrVal TextVertical
TextVerticalHorz = Text
"horz"
  toAttrVal TextVertical
TextVertical = Text
"vert"
  toAttrVal TextVertical
TextVertical270 = Text
"vert270"
  toAttrVal TextVertical
TextVerticalWordArt = Text
"wordArtVert"
  toAttrVal TextVertical
TextVerticalEA = Text
"eaVert"
  toAttrVal TextVertical
TextVerticalMongolian = Text
"mongolianVert"
  toAttrVal TextVertical
TextVerticalWordArtRtl = Text
"wordArtVertRtl"

instance ToAttrVal TextWrap where
  toAttrVal :: TextWrap -> Text
toAttrVal TextWrap
TextWrapNone = Text
"none"
  toAttrVal TextWrap
TextWrapSquare = Text
"square"

-- See 20.1.10.59 "ST_TextAnchoringType (Text Anchoring Types)" (p. 3058)
instance ToAttrVal TextAnchoring where
  toAttrVal :: TextAnchoring -> Text
toAttrVal TextAnchoring
TextAnchoringTop = Text
"t"
  toAttrVal TextAnchoring
TextAnchoringCenter = Text
"ctr"
  toAttrVal TextAnchoring
TextAnchoringBottom = Text
"b"
  toAttrVal TextAnchoring
TextAnchoringJustified = Text
"just"
  toAttrVal TextAnchoring
TextAnchoringDistributed = Text
"dist"

instance ToAttrVal Angle where
  toAttrVal :: Angle -> Text
toAttrVal (Angle Int
x) = forall a. ToAttrVal a => a -> Text
toAttrVal Int
x

instance ToElement ShapeProperties where
    toElement :: Name -> ShapeProperties -> Element
toElement Name
nm ShapeProperties{Maybe FillProperties
Maybe LineProperties
Maybe Geometry
Maybe Transform2D
_spOutline :: Maybe LineProperties
_spFill :: Maybe FillProperties
_spGeometry :: Maybe Geometry
_spXfrm :: Maybe Transform2D
_spOutline :: ShapeProperties -> Maybe LineProperties
_spFill :: ShapeProperties -> Maybe FillProperties
_spGeometry :: ShapeProperties -> Maybe Geometry
_spXfrm :: ShapeProperties -> Maybe Transform2D
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
      where
        elements :: [Element]
elements = forall a. [Maybe a] -> [a]
catMaybes [ forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"xfrm") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Transform2D
_spXfrm
                             , Geometry -> Element
geometryToElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Geometry
_spGeometry
                             , FillProperties -> Element
fillPropsToElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FillProperties
_spFill
                             , forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"ln")  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LineProperties
_spOutline ]

instance ToElement Point2D where
    toElement :: Name -> Point2D -> Element
toElement Name
nm Point2D{Coordinate
_pt2dY :: Coordinate
_pt2dX :: Coordinate
_pt2dY :: Point2D -> Coordinate
_pt2dX :: Point2D -> Coordinate
..} = Name -> [(Name, Text)] -> Element
leafElement Name
nm [ Name
"x" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Coordinate
_pt2dX
                                              , Name
"y" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Coordinate
_pt2dY
                                              ]

instance ToElement PositiveSize2D where
    toElement :: Name -> PositiveSize2D -> Element
toElement Name
nm PositiveSize2D{PositiveCoordinate
_ps2dY :: PositiveCoordinate
_ps2dX :: PositiveCoordinate
_ps2dY :: PositiveSize2D -> PositiveCoordinate
_ps2dX :: PositiveSize2D -> PositiveCoordinate
..} = Name -> [(Name, Text)] -> Element
leafElement Name
nm [ Name
"cx" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= PositiveCoordinate
_ps2dX
                                                     , Name
"cy" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= PositiveCoordinate
_ps2dY ]

instance ToAttrVal Coordinate where
    toAttrVal :: Coordinate -> Text
toAttrVal (UnqCoordinate Int
x) = forall a. ToAttrVal a => a -> Text
toAttrVal Int
x
    toAttrVal (UniversalMeasure UnitIdentifier
unit Double
x) = forall a. ToAttrVal a => a -> Text
toAttrVal Double
x forall a. Semigroup a => a -> a -> a
<> forall {a}. IsString a => UnitIdentifier -> a
unitToText UnitIdentifier
unit
      where
        unitToText :: UnitIdentifier -> a
unitToText UnitIdentifier
UnitCm = a
"cm"
        unitToText UnitIdentifier
UnitMm = a
"mm"
        unitToText UnitIdentifier
UnitIn = a
"in"
        unitToText UnitIdentifier
UnitPt = a
"pt"
        unitToText UnitIdentifier
UnitPc = a
"pc"
        unitToText UnitIdentifier
UnitPi = a
"pi"

instance ToAttrVal PositiveCoordinate where
    toAttrVal :: PositiveCoordinate -> Text
toAttrVal (PositiveCoordinate Integer
x) = forall a. ToAttrVal a => a -> Text
toAttrVal Integer
x

instance ToElement Transform2D where
    toElement :: Name -> Transform2D -> Element
toElement Name
nm Transform2D{Bool
Maybe PositiveSize2D
Maybe Point2D
Angle
_trExtents :: Maybe PositiveSize2D
_trOffset :: Maybe Point2D
_trFlipV :: Bool
_trFlipH :: Bool
_trRot :: Angle
_trExtents :: Transform2D -> Maybe PositiveSize2D
_trOffset :: Transform2D -> Maybe Point2D
_trFlipV :: Transform2D -> Bool
_trFlipH :: Transform2D -> Bool
_trRot :: Transform2D -> Angle
..} = Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
nm [(Name, Text)]
attrs [Element]
elements
      where
        attrs :: [(Name, Text)]
attrs = forall a. [Maybe a] -> [a]
catMaybes [ Name
"rot"   forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? forall a. Eq a => a -> a -> Maybe a
justNonDef (Int -> Angle
Angle Int
0) Angle
_trRot
                          , Name
"flipH" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_trFlipH
                          , Name
"flipV" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_trFlipV ]
        elements :: [Element]
elements = forall a. [Maybe a] -> [a]
catMaybes [ forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"off") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Point2D
_trOffset
                             , forall a. ToElement a => Name -> a -> Element
toElement (Text -> Name
a_ Text
"ext") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PositiveSize2D
_trExtents ]

geometryToElement :: Geometry -> Element
geometryToElement :: Geometry -> Element
geometryToElement Geometry
PresetGeometry =
  Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
a_ Text
"prstGeom") [Name
"prst" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= (Text
"rect" :: Text)]

instance ToElement LineProperties where
  toElement :: Name -> LineProperties -> Element
toElement Name
nm LineProperties {Int
Maybe FillProperties
_lnWidth :: Int
_lnFill :: Maybe FillProperties
_lnWidth :: LineProperties -> Int
_lnFill :: LineProperties -> Maybe FillProperties
..} = Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
nm [(Name, Text)]
attrs [Element]
elements
    where
      attrs :: [(Name, Text)]
attrs = forall a. [Maybe a] -> [a]
catMaybes [Name
"w" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? forall a. Eq a => a -> a -> Maybe a
justNonDef Int
0 Int
_lnWidth]
      elements :: [Element]
elements = forall a. [Maybe a] -> [a]
catMaybes [FillProperties -> Element
fillPropsToElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FillProperties
_lnFill]

fillPropsToElement :: FillProperties -> Element
fillPropsToElement :: FillProperties -> Element
fillPropsToElement FillProperties
NoFill = Name -> Element
emptyElement (Text -> Name
a_ Text
"noFill")
fillPropsToElement (SolidFill Maybe ColorChoice
color) =
  Name -> [Element] -> Element
elementListSimple (Text -> Name
a_ Text
"solidFill") forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [ColorChoice -> Element
colorChoiceToElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ColorChoice
color]

colorChoiceToElement :: ColorChoice -> Element
colorChoiceToElement :: ColorChoice -> Element
colorChoiceToElement (RgbColor Text
color) =
  Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
a_ Text
"srgbClr") [Name
"val" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
color]

-- | Add DrawingML namespace to name
a_ :: Text -> Name
a_ :: Text -> Name
a_ Text
x =
  Name {nameLocalName :: Text
nameLocalName = Text
x, nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
drawingNs, namePrefix :: Maybe Text
namePrefix = forall a. a -> Maybe a
Just Text
"a"}

drawingNs :: Text
drawingNs :: Text
drawingNs = Text
"http://schemas.openxmlformats.org/drawingml/2006/main"