{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Drawing where

import Control.Arrow (first)
import Control.DeepSeq (NFData)
#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens.TH
#endif
import Data.ByteString.Lazy (ByteString)
import Data.Default
import qualified Data.Map as M
import Data.Maybe (catMaybes, listToMaybe, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Drawing.Chart
import Codec.Xlsx.Types.Drawing.Common
import Codec.Xlsx.Types.Internal
import Codec.Xlsx.Types.Internal.Relationships
import Codec.Xlsx.Writer.Internal

-- | information about image file as a par of a drawing
data FileInfo = FileInfo
    { FileInfo -> FilePath
_fiFilename    :: FilePath
    -- ^ image filename, images are assumed to be stored under path "xl\/media\/"
    , FileInfo -> Text
_fiContentType :: Text
    -- ^ image content type, ECMA-376 advises to use "image\/png" or "image\/jpeg"
    -- if interoperability is wanted
    , FileInfo -> ByteString
_fiContents    :: ByteString
    -- ^ image file contents
    } deriving (FileInfo -> FileInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c== :: FileInfo -> FileInfo -> Bool
Eq, Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> FilePath
$cshow :: FileInfo -> FilePath
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> FileInfo -> ShowS
Show, forall x. Rep FileInfo x -> FileInfo
forall x. FileInfo -> Rep FileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileInfo x -> FileInfo
$cfrom :: forall x. FileInfo -> Rep FileInfo x
Generic)
instance NFData FileInfo

data Marker = Marker
    { Marker -> Int
_mrkCol    :: Int
    , Marker -> Coordinate
_mrkColOff :: Coordinate
    , Marker -> Int
_mrkRow    :: Int
    , Marker -> Coordinate
_mrkRowOff :: Coordinate
    } deriving (Marker -> Marker -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Marker -> Marker -> Bool
$c/= :: Marker -> Marker -> Bool
== :: Marker -> Marker -> Bool
$c== :: Marker -> Marker -> Bool
Eq, Int -> Marker -> ShowS
[Marker] -> ShowS
Marker -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Marker] -> ShowS
$cshowList :: [Marker] -> ShowS
show :: Marker -> FilePath
$cshow :: Marker -> FilePath
showsPrec :: Int -> Marker -> ShowS
$cshowsPrec :: Int -> Marker -> ShowS
Show, forall x. Rep Marker x -> Marker
forall x. Marker -> Rep Marker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Marker x -> Marker
$cfrom :: forall x. Marker -> Rep Marker x
Generic)
instance NFData Marker

unqMarker :: (Int, Int) -> (Int, Int) -> Marker
unqMarker :: (Int, Int) -> (Int, Int) -> Marker
unqMarker (Int
col, Int
colOff) (Int
row, Int
rowOff) =
    Int -> Coordinate -> Int -> Coordinate -> Marker
Marker Int
col (Int -> Coordinate
UnqCoordinate Int
colOff) Int
row (Int -> Coordinate
UnqCoordinate Int
rowOff)

data EditAs
    = EditAsTwoCell
    | EditAsOneCell
    | EditAsAbsolute
    deriving (EditAs -> EditAs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditAs -> EditAs -> Bool
$c/= :: EditAs -> EditAs -> Bool
== :: EditAs -> EditAs -> Bool
$c== :: EditAs -> EditAs -> Bool
Eq, Int -> EditAs -> ShowS
[EditAs] -> ShowS
EditAs -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EditAs] -> ShowS
$cshowList :: [EditAs] -> ShowS
show :: EditAs -> FilePath
$cshow :: EditAs -> FilePath
showsPrec :: Int -> EditAs -> ShowS
$cshowsPrec :: Int -> EditAs -> ShowS
Show, forall x. Rep EditAs x -> EditAs
forall x. EditAs -> Rep EditAs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditAs x -> EditAs
$cfrom :: forall x. EditAs -> Rep EditAs x
Generic)
instance NFData EditAs

data Anchoring
    = AbsoluteAnchor
      { Anchoring -> Point2D
absaPos :: Point2D
      , Anchoring -> PositiveSize2D
absaExt :: PositiveSize2D
      }
    | OneCellAnchor
      { Anchoring -> Marker
onecaFrom :: Marker
      , Anchoring -> PositiveSize2D
onecaExt  :: PositiveSize2D
      }
    | TwoCellAnchor
      { Anchoring -> Marker
tcaFrom   :: Marker
      , Anchoring -> Marker
tcaTo     :: Marker
      , Anchoring -> EditAs
tcaEditAs :: EditAs
      }
    deriving (Anchoring -> Anchoring -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Anchoring -> Anchoring -> Bool
$c/= :: Anchoring -> Anchoring -> Bool
== :: Anchoring -> Anchoring -> Bool
$c== :: Anchoring -> Anchoring -> Bool
Eq, Int -> Anchoring -> ShowS
[Anchoring] -> ShowS
Anchoring -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Anchoring] -> ShowS
$cshowList :: [Anchoring] -> ShowS
show :: Anchoring -> FilePath
$cshow :: Anchoring -> FilePath
showsPrec :: Int -> Anchoring -> ShowS
$cshowsPrec :: Int -> Anchoring -> ShowS
Show, forall x. Rep Anchoring x -> Anchoring
forall x. Anchoring -> Rep Anchoring x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Anchoring x -> Anchoring
$cfrom :: forall x. Anchoring -> Rep Anchoring x
Generic)
instance NFData Anchoring

data DrawingObject p g
  = Picture { forall p g. DrawingObject p g -> Maybe Text
_picMacro :: Maybe Text
           ,  forall p g. DrawingObject p g -> Bool
_picPublished :: Bool
           ,  forall p g. DrawingObject p g -> PicNonVisual
_picNonVisual :: PicNonVisual
           ,  forall p g. DrawingObject p g -> BlipFillProperties p
_picBlipFill :: BlipFillProperties p
           ,  forall p g. DrawingObject p g -> ShapeProperties
_picShapeProperties :: ShapeProperties
              -- TODO: style
            }
  | Graphic { forall p g. DrawingObject p g -> GraphNonVisual
_grNonVisual :: GraphNonVisual
           ,  forall p g. DrawingObject p g -> g
_grChartSpace :: g
           ,  forall p g. DrawingObject p g -> Transform2D
_grTransform :: Transform2D}
    -- TODO: sp, grpSp, graphicFrame, cxnSp, contentPart
  deriving (DrawingObject p g -> DrawingObject p g -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p g.
(Eq p, Eq g) =>
DrawingObject p g -> DrawingObject p g -> Bool
/= :: DrawingObject p g -> DrawingObject p g -> Bool
$c/= :: forall p g.
(Eq p, Eq g) =>
DrawingObject p g -> DrawingObject p g -> Bool
== :: DrawingObject p g -> DrawingObject p g -> Bool
$c== :: forall p g.
(Eq p, Eq g) =>
DrawingObject p g -> DrawingObject p g -> Bool
Eq, Int -> DrawingObject p g -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall p g. (Show p, Show g) => Int -> DrawingObject p g -> ShowS
forall p g. (Show p, Show g) => [DrawingObject p g] -> ShowS
forall p g. (Show p, Show g) => DrawingObject p g -> FilePath
showList :: [DrawingObject p g] -> ShowS
$cshowList :: forall p g. (Show p, Show g) => [DrawingObject p g] -> ShowS
show :: DrawingObject p g -> FilePath
$cshow :: forall p g. (Show p, Show g) => DrawingObject p g -> FilePath
showsPrec :: Int -> DrawingObject p g -> ShowS
$cshowsPrec :: forall p g. (Show p, Show g) => Int -> DrawingObject p g -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p g x. Rep (DrawingObject p g) x -> DrawingObject p g
forall p g x. DrawingObject p g -> Rep (DrawingObject p g) x
$cto :: forall p g x. Rep (DrawingObject p g) x -> DrawingObject p g
$cfrom :: forall p g x. DrawingObject p g -> Rep (DrawingObject p g) x
Generic)
instance (NFData p, NFData g) => NFData (DrawingObject p g)

-- | basic function to create picture drawing object
--
-- /Note:/ specification says that drawing element ids need to be
-- unique within 1 document, otherwise /...document shall be
-- considered non-conformant/.
picture :: DrawingElementId -> FileInfo -> DrawingObject FileInfo c
picture :: forall c. DrawingElementId -> FileInfo -> DrawingObject FileInfo c
picture DrawingElementId
dId FileInfo
fi =
  Picture
  { _picMacro :: Maybe Text
_picMacro = forall a. Maybe a
Nothing
  , _picPublished :: Bool
_picPublished = Bool
False
  , _picNonVisual :: PicNonVisual
_picNonVisual = PicNonVisual
nonVis
  , _picBlipFill :: BlipFillProperties FileInfo
_picBlipFill = BlipFillProperties FileInfo
bfProps
  , _picShapeProperties :: ShapeProperties
_picShapeProperties = ShapeProperties
shProps
  }
  where
    nonVis :: PicNonVisual
nonVis =
      NonVisualDrawingProperties -> PicNonVisual
PicNonVisual forall a b. (a -> b) -> a -> b
$
      NonVisualDrawingProperties
      { _nvdpId :: DrawingElementId
_nvdpId = DrawingElementId
dId
      , _nvdpName :: Text
_nvdpName = FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FileInfo -> FilePath
_fiFilename FileInfo
fi
      , _nvdpDescription :: Maybe Text
_nvdpDescription = forall a. Maybe a
Nothing
      , _nvdpHidden :: Bool
_nvdpHidden = Bool
False
      , _nvdpTitle :: Maybe Text
_nvdpTitle = forall a. Maybe a
Nothing
      }
    bfProps :: BlipFillProperties FileInfo
bfProps =
      BlipFillProperties
      {_bfpImageInfo :: Maybe FileInfo
_bfpImageInfo = forall a. a -> Maybe a
Just FileInfo
fi, _bfpFillMode :: Maybe FillMode
_bfpFillMode = forall a. a -> Maybe a
Just FillMode
FillStretch}
    shProps :: ShapeProperties
shProps =
      ShapeProperties
      { _spXfrm :: Maybe Transform2D
_spXfrm = forall a. Maybe a
Nothing
      , _spGeometry :: Maybe Geometry
_spGeometry = forall a. Maybe a
Nothing
      , _spFill :: Maybe FillProperties
_spFill = forall a. a -> Maybe a
Just FillProperties
NoFill
      , _spOutline :: Maybe LineProperties
_spOutline = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {_lnFill :: Maybe FillProperties
_lnFill = forall a. a -> Maybe a
Just FillProperties
NoFill}
      }

-- | helper to retrive information about all picture files in
-- particular drawing alongside with their anchorings (i.e. sizes and
-- positions)
extractPictures :: Drawing -> [(Anchoring, FileInfo)]
extractPictures :: Drawing -> [(Anchoring, FileInfo)]
extractPictures Drawing
dr = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {g}. Anchor a g -> Maybe (Anchoring, a)
maybePictureInfo forall a b. (a -> b) -> a -> b
$ forall p g. GenericDrawing p g -> [Anchor p g]
_xdrAnchors Drawing
dr
  where
    maybePictureInfo :: Anchor a g -> Maybe (Anchoring, a)
maybePictureInfo Anchor {ClientData
DrawingObject a g
Anchoring
_anchClientData :: forall p g. Anchor p g -> ClientData
_anchObject :: forall p g. Anchor p g -> DrawingObject p g
_anchAnchoring :: forall p g. Anchor p g -> Anchoring
_anchClientData :: ClientData
_anchObject :: DrawingObject a g
_anchAnchoring :: Anchoring
..} =
      case DrawingObject a g
_anchObject of
        Picture {Bool
Maybe Text
ShapeProperties
BlipFillProperties a
PicNonVisual
_picShapeProperties :: ShapeProperties
_picBlipFill :: BlipFillProperties a
_picNonVisual :: PicNonVisual
_picPublished :: Bool
_picMacro :: Maybe Text
_picShapeProperties :: forall p g. DrawingObject p g -> ShapeProperties
_picBlipFill :: forall p g. DrawingObject p g -> BlipFillProperties p
_picNonVisual :: forall p g. DrawingObject p g -> PicNonVisual
_picPublished :: forall p g. DrawingObject p g -> Bool
_picMacro :: forall p g. DrawingObject p g -> Maybe Text
..} -> (Anchoring
_anchAnchoring,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BlipFillProperties a -> Maybe a
_bfpImageInfo BlipFillProperties a
_picBlipFill
        DrawingObject a g
_ -> forall a. Maybe a
Nothing

-- | This element is used to set certain properties related to a drawing
-- element on the client spreadsheet application.
--
-- see 20.5.2.3 "clientData (Client Data)" (p. 3156)
data ClientData = ClientData
    { ClientData -> Bool
_cldLcksWithSheet   :: Bool
    -- ^ This attribute indicates whether to disable selection on
    -- drawing elements when the sheet is protected.
    , ClientData -> Bool
_cldPrintsWithSheet :: Bool
    -- ^ This attribute indicates whether to print drawing elements
    -- when printing the sheet.
    } deriving (ClientData -> ClientData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientData -> ClientData -> Bool
$c/= :: ClientData -> ClientData -> Bool
== :: ClientData -> ClientData -> Bool
$c== :: ClientData -> ClientData -> Bool
Eq, Int -> ClientData -> ShowS
[ClientData] -> ShowS
ClientData -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ClientData] -> ShowS
$cshowList :: [ClientData] -> ShowS
show :: ClientData -> FilePath
$cshow :: ClientData -> FilePath
showsPrec :: Int -> ClientData -> ShowS
$cshowsPrec :: Int -> ClientData -> ShowS
Show, forall x. Rep ClientData x -> ClientData
forall x. ClientData -> Rep ClientData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientData x -> ClientData
$cfrom :: forall x. ClientData -> Rep ClientData x
Generic)
instance NFData ClientData

data PicNonVisual = PicNonVisual
  { PicNonVisual -> NonVisualDrawingProperties
_pnvDrawingProps :: NonVisualDrawingProperties
    -- TODO: cNvPicPr
  } deriving (PicNonVisual -> PicNonVisual -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PicNonVisual -> PicNonVisual -> Bool
$c/= :: PicNonVisual -> PicNonVisual -> Bool
== :: PicNonVisual -> PicNonVisual -> Bool
$c== :: PicNonVisual -> PicNonVisual -> Bool
Eq, Int -> PicNonVisual -> ShowS
[PicNonVisual] -> ShowS
PicNonVisual -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PicNonVisual] -> ShowS
$cshowList :: [PicNonVisual] -> ShowS
show :: PicNonVisual -> FilePath
$cshow :: PicNonVisual -> FilePath
showsPrec :: Int -> PicNonVisual -> ShowS
$cshowsPrec :: Int -> PicNonVisual -> ShowS
Show, forall x. Rep PicNonVisual x -> PicNonVisual
forall x. PicNonVisual -> Rep PicNonVisual x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PicNonVisual x -> PicNonVisual
$cfrom :: forall x. PicNonVisual -> Rep PicNonVisual x
Generic)
instance NFData PicNonVisual

data GraphNonVisual = GraphNonVisual
  { GraphNonVisual -> NonVisualDrawingProperties
_gnvDrawingProps :: NonVisualDrawingProperties
    -- TODO cNvGraphicFramePr
  } deriving (GraphNonVisual -> GraphNonVisual -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphNonVisual -> GraphNonVisual -> Bool
$c/= :: GraphNonVisual -> GraphNonVisual -> Bool
== :: GraphNonVisual -> GraphNonVisual -> Bool
$c== :: GraphNonVisual -> GraphNonVisual -> Bool
Eq, Int -> GraphNonVisual -> ShowS
[GraphNonVisual] -> ShowS
GraphNonVisual -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GraphNonVisual] -> ShowS
$cshowList :: [GraphNonVisual] -> ShowS
show :: GraphNonVisual -> FilePath
$cshow :: GraphNonVisual -> FilePath
showsPrec :: Int -> GraphNonVisual -> ShowS
$cshowsPrec :: Int -> GraphNonVisual -> ShowS
Show, forall x. Rep GraphNonVisual x -> GraphNonVisual
forall x. GraphNonVisual -> Rep GraphNonVisual x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GraphNonVisual x -> GraphNonVisual
$cfrom :: forall x. GraphNonVisual -> Rep GraphNonVisual x
Generic)
instance NFData GraphNonVisual

newtype DrawingElementId = DrawingElementId
  { DrawingElementId -> Int
unDrawingElementId :: Int
  } deriving (DrawingElementId -> DrawingElementId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DrawingElementId -> DrawingElementId -> Bool
$c/= :: DrawingElementId -> DrawingElementId -> Bool
== :: DrawingElementId -> DrawingElementId -> Bool
$c== :: DrawingElementId -> DrawingElementId -> Bool
Eq, Int -> DrawingElementId -> ShowS
[DrawingElementId] -> ShowS
DrawingElementId -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DrawingElementId] -> ShowS
$cshowList :: [DrawingElementId] -> ShowS
show :: DrawingElementId -> FilePath
$cshow :: DrawingElementId -> FilePath
showsPrec :: Int -> DrawingElementId -> ShowS
$cshowsPrec :: Int -> DrawingElementId -> ShowS
Show, forall x. Rep DrawingElementId x -> DrawingElementId
forall x. DrawingElementId -> Rep DrawingElementId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DrawingElementId x -> DrawingElementId
$cfrom :: forall x. DrawingElementId -> Rep DrawingElementId x
Generic)
instance NFData DrawingElementId

-- see 20.1.2.2.8 "cNvPr (Non-Visual Drawing Properties)" (p. 2731)
data NonVisualDrawingProperties = NonVisualDrawingProperties
    { NonVisualDrawingProperties -> DrawingElementId
_nvdpId          :: DrawingElementId
    -- ^ Specifies a unique identifier for the current
    -- DrawingML object within the current
    --
    -- TODO: make ids internal and consistent by construction
    , NonVisualDrawingProperties -> Text
_nvdpName        :: Text
    -- ^ Specifies the name of the object.
    -- Typically, this is used to store the original file
    -- name of a picture object.
    , NonVisualDrawingProperties -> Maybe Text
_nvdpDescription :: Maybe Text
    -- ^ Alternative Text for Object
    , NonVisualDrawingProperties -> Bool
_nvdpHidden      :: Bool
    , NonVisualDrawingProperties -> Maybe Text
_nvdpTitle       :: Maybe Text
    } deriving (NonVisualDrawingProperties -> NonVisualDrawingProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonVisualDrawingProperties -> NonVisualDrawingProperties -> Bool
$c/= :: NonVisualDrawingProperties -> NonVisualDrawingProperties -> Bool
== :: NonVisualDrawingProperties -> NonVisualDrawingProperties -> Bool
$c== :: NonVisualDrawingProperties -> NonVisualDrawingProperties -> Bool
Eq, Int -> NonVisualDrawingProperties -> ShowS
[NonVisualDrawingProperties] -> ShowS
NonVisualDrawingProperties -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NonVisualDrawingProperties] -> ShowS
$cshowList :: [NonVisualDrawingProperties] -> ShowS
show :: NonVisualDrawingProperties -> FilePath
$cshow :: NonVisualDrawingProperties -> FilePath
showsPrec :: Int -> NonVisualDrawingProperties -> ShowS
$cshowsPrec :: Int -> NonVisualDrawingProperties -> ShowS
Show, forall x.
Rep NonVisualDrawingProperties x -> NonVisualDrawingProperties
forall x.
NonVisualDrawingProperties -> Rep NonVisualDrawingProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep NonVisualDrawingProperties x -> NonVisualDrawingProperties
$cfrom :: forall x.
NonVisualDrawingProperties -> Rep NonVisualDrawingProperties x
Generic)
instance NFData NonVisualDrawingProperties

data BlipFillProperties a = BlipFillProperties
    { forall a. BlipFillProperties a -> Maybe a
_bfpImageInfo :: Maybe a
    , forall a. BlipFillProperties a -> Maybe FillMode
_bfpFillMode  :: Maybe FillMode
    -- TODO: dpi, rotWithShape, srcRect
    } deriving (BlipFillProperties a -> BlipFillProperties a -> Bool
forall a.
Eq a =>
BlipFillProperties a -> BlipFillProperties a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlipFillProperties a -> BlipFillProperties a -> Bool
$c/= :: forall a.
Eq a =>
BlipFillProperties a -> BlipFillProperties a -> Bool
== :: BlipFillProperties a -> BlipFillProperties a -> Bool
$c== :: forall a.
Eq a =>
BlipFillProperties a -> BlipFillProperties a -> Bool
Eq, Int -> BlipFillProperties a -> ShowS
forall a. Show a => Int -> BlipFillProperties a -> ShowS
forall a. Show a => [BlipFillProperties a] -> ShowS
forall a. Show a => BlipFillProperties a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BlipFillProperties a] -> ShowS
$cshowList :: forall a. Show a => [BlipFillProperties a] -> ShowS
show :: BlipFillProperties a -> FilePath
$cshow :: forall a. Show a => BlipFillProperties a -> FilePath
showsPrec :: Int -> BlipFillProperties a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BlipFillProperties a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BlipFillProperties a) x -> BlipFillProperties a
forall a x. BlipFillProperties a -> Rep (BlipFillProperties a) x
$cto :: forall a x. Rep (BlipFillProperties a) x -> BlipFillProperties a
$cfrom :: forall a x. BlipFillProperties a -> Rep (BlipFillProperties a) x
Generic)
instance NFData a => NFData (BlipFillProperties a)

-- see @a_EG_FillModeProperties@ (p. 4319)
data FillMode
    -- See 20.1.8.58 "tile (Tile)" (p. 2880)
    = FillTile    -- TODO: tx, ty, sx, sy, flip, algn
    -- See 20.1.8.56 "stretch (Stretch)" (p. 2879)
    | FillStretch -- TODO: srcRect
    deriving (FillMode -> FillMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillMode -> FillMode -> Bool
$c/= :: FillMode -> FillMode -> Bool
== :: FillMode -> FillMode -> Bool
$c== :: FillMode -> FillMode -> Bool
Eq, Int -> FillMode -> ShowS
[FillMode] -> ShowS
FillMode -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FillMode] -> ShowS
$cshowList :: [FillMode] -> ShowS
show :: FillMode -> FilePath
$cshow :: FillMode -> FilePath
showsPrec :: Int -> FillMode -> ShowS
$cshowsPrec :: Int -> FillMode -> ShowS
Show, forall x. Rep FillMode x -> FillMode
forall x. FillMode -> Rep FillMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FillMode x -> FillMode
$cfrom :: forall x. FillMode -> Rep FillMode x
Generic)
instance NFData FillMode

-- See @EG_Anchor@ (p. 4052)
data Anchor p g = Anchor
    { forall p g. Anchor p g -> Anchoring
_anchAnchoring  :: Anchoring
    , forall p g. Anchor p g -> DrawingObject p g
_anchObject     :: DrawingObject p g
    , forall p g. Anchor p g -> ClientData
_anchClientData :: ClientData
    } deriving (Anchor p g -> Anchor p g -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p g. (Eq p, Eq g) => Anchor p g -> Anchor p g -> Bool
/= :: Anchor p g -> Anchor p g -> Bool
$c/= :: forall p g. (Eq p, Eq g) => Anchor p g -> Anchor p g -> Bool
== :: Anchor p g -> Anchor p g -> Bool
$c== :: forall p g. (Eq p, Eq g) => Anchor p g -> Anchor p g -> Bool
Eq, Int -> Anchor p g -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall p g. (Show p, Show g) => Int -> Anchor p g -> ShowS
forall p g. (Show p, Show g) => [Anchor p g] -> ShowS
forall p g. (Show p, Show g) => Anchor p g -> FilePath
showList :: [Anchor p g] -> ShowS
$cshowList :: forall p g. (Show p, Show g) => [Anchor p g] -> ShowS
show :: Anchor p g -> FilePath
$cshow :: forall p g. (Show p, Show g) => Anchor p g -> FilePath
showsPrec :: Int -> Anchor p g -> ShowS
$cshowsPrec :: forall p g. (Show p, Show g) => Int -> Anchor p g -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p g x. Rep (Anchor p g) x -> Anchor p g
forall p g x. Anchor p g -> Rep (Anchor p g) x
$cto :: forall p g x. Rep (Anchor p g) x -> Anchor p g
$cfrom :: forall p g x. Anchor p g -> Rep (Anchor p g) x
Generic)
instance (NFData p, NFData g) => NFData (Anchor p g)

data GenericDrawing p g = Drawing
    { forall p g. GenericDrawing p g -> [Anchor p g]
_xdrAnchors :: [Anchor p g]
    } deriving (GenericDrawing p g -> GenericDrawing p g -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p g.
(Eq p, Eq g) =>
GenericDrawing p g -> GenericDrawing p g -> Bool
/= :: GenericDrawing p g -> GenericDrawing p g -> Bool
$c/= :: forall p g.
(Eq p, Eq g) =>
GenericDrawing p g -> GenericDrawing p g -> Bool
== :: GenericDrawing p g -> GenericDrawing p g -> Bool
$c== :: forall p g.
(Eq p, Eq g) =>
GenericDrawing p g -> GenericDrawing p g -> Bool
Eq, Int -> GenericDrawing p g -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall p g. (Show p, Show g) => Int -> GenericDrawing p g -> ShowS
forall p g. (Show p, Show g) => [GenericDrawing p g] -> ShowS
forall p g. (Show p, Show g) => GenericDrawing p g -> FilePath
showList :: [GenericDrawing p g] -> ShowS
$cshowList :: forall p g. (Show p, Show g) => [GenericDrawing p g] -> ShowS
show :: GenericDrawing p g -> FilePath
$cshow :: forall p g. (Show p, Show g) => GenericDrawing p g -> FilePath
showsPrec :: Int -> GenericDrawing p g -> ShowS
$cshowsPrec :: forall p g. (Show p, Show g) => Int -> GenericDrawing p g -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p g x. Rep (GenericDrawing p g) x -> GenericDrawing p g
forall p g x. GenericDrawing p g -> Rep (GenericDrawing p g) x
$cto :: forall p g x. Rep (GenericDrawing p g) x -> GenericDrawing p g
$cfrom :: forall p g x. GenericDrawing p g -> Rep (GenericDrawing p g) x
Generic)
instance (NFData p, NFData g) => NFData (GenericDrawing p g)

-- See 20.5.2.35 "wsDr (Worksheet Drawing)" (p. 3176)
type Drawing = GenericDrawing FileInfo ChartSpace

type UnresolvedDrawing = GenericDrawing RefId RefId

makeLenses ''Anchor
makeLenses ''DrawingObject
makeLenses ''BlipFillProperties
makeLenses ''GenericDrawing

-- | simple drawing object anchoring using one cell as a top lelft
-- corner and dimensions of that object
simpleAnchorXY :: (Int, Int) -- ^ x+y coordinates of a cell used as
                             -- top left anchoring corner
               -> PositiveSize2D -- ^ size of drawing object to be
                                 -- anchored
               -> DrawingObject p g
               -> Anchor p g
simpleAnchorXY :: forall p g.
(Int, Int) -> PositiveSize2D -> DrawingObject p g -> Anchor p g
simpleAnchorXY (Int
x, Int
y) PositiveSize2D
sz DrawingObject p g
obj =
  Anchor
  { _anchAnchoring :: Anchoring
_anchAnchoring =
      OneCellAnchor {onecaFrom :: Marker
onecaFrom = (Int, Int) -> (Int, Int) -> Marker
unqMarker (Int
x, Int
0) (Int
y, Int
0), onecaExt :: PositiveSize2D
onecaExt = PositiveSize2D
sz}
  , _anchObject :: DrawingObject p g
_anchObject = DrawingObject p g
obj
  , _anchClientData :: ClientData
_anchClientData = forall a. Default a => a
def
  }

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

instance Default ClientData where
    def :: ClientData
def = Bool -> Bool -> ClientData
ClientData Bool
True Bool
True

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

instance FromCursor UnresolvedDrawing where
    fromCursor :: Cursor -> [UnresolvedDrawing]
fromCursor Cursor
cur = [forall p g. [Anchor p g] -> GenericDrawing p g
Drawing 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]

instance FromCursor (Anchor RefId RefId) where
    fromCursor :: Cursor -> [Anchor RefId RefId]
fromCursor Cursor
cur = do
        Anchoring
_anchAnchoring  <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
        DrawingObject RefId RefId
_anchObject     <- 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
        ClientData
_anchClientData <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"clientData") 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 Anchor{ClientData
DrawingObject RefId RefId
Anchoring
_anchClientData :: ClientData
_anchObject :: DrawingObject RefId RefId
_anchAnchoring :: Anchoring
_anchClientData :: ClientData
_anchObject :: DrawingObject RefId RefId
_anchAnchoring :: Anchoring
..}

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

anchoringFromNode :: Node -> [Anchoring]
anchoringFromNode :: Node -> [Anchoring]
anchoringFromNode Node
n | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
xdr Text
"twoCellAnchor" = do
                          EditAs
tcaEditAs <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"editAs" EditAs
EditAsTwoCell Cursor
cur
                          Marker
tcaFrom <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"from") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
                          Marker
tcaTo <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"to") 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 TwoCellAnchor{EditAs
Marker
tcaTo :: Marker
tcaFrom :: Marker
tcaEditAs :: EditAs
tcaEditAs :: EditAs
tcaTo :: Marker
tcaFrom :: Marker
..}
                    | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
xdr Text
"oneCellAnchor" = do
                          Marker
onecaFrom <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"from") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
                          PositiveSize2D
onecaExt <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"ext") 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 OneCellAnchor{PositiveSize2D
Marker
onecaExt :: PositiveSize2D
onecaFrom :: Marker
onecaExt :: PositiveSize2D
onecaFrom :: Marker
..}
                    | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
xdr Text
"absolueAnchor" = do
                          Point2D
absaPos <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"pos") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
                          PositiveSize2D
absaExt <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"ext") 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 AbsoluteAnchor{PositiveSize2D
Point2D
absaExt :: PositiveSize2D
absaPos :: Point2D
absaExt :: PositiveSize2D
absaPos :: Point2D
..}
                    | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no matching anchoring node"
  where
    cur :: Cursor
cur = Node -> Cursor
fromNode Node
n

instance FromCursor Marker where
    fromCursor :: Cursor -> [Marker]
fromCursor Cursor
cur = do
        Int
_mrkCol <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"col") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
        Coordinate
_mrkColOff <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"colOff") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *). MonadFail m => Text -> m Coordinate
coordinate
        Int
_mrkRow <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"row") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
        Coordinate
_mrkRowOff <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"rowOff") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *). MonadFail m => Text -> m Coordinate
coordinate
        forall (m :: * -> *) a. Monad m => a -> m a
return Marker{Int
Coordinate
_mrkRowOff :: Coordinate
_mrkRow :: Int
_mrkColOff :: Coordinate
_mrkCol :: Int
_mrkRowOff :: Coordinate
_mrkRow :: Int
_mrkColOff :: Coordinate
_mrkCol :: Int
..}

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

drawingObjectFromNode :: Node -> [DrawingObject RefId RefId]
drawingObjectFromNode :: Node -> [DrawingObject RefId RefId]
drawingObjectFromNode Node
n
  | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
xdr Text
"pic" = do
    Maybe Text
_picMacro <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"macro" Cursor
cur
    Bool
_picPublished <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"fPublished" Bool
False Cursor
cur
    PicNonVisual
_picNonVisual <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdr Text
"nvPicPr") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    BlipFillProperties RefId
_picBlipFill <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdr Text
"blipFill") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    ShapeProperties
_picShapeProperties <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdr Text
"spPr") 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 Picture {Bool
Maybe Text
ShapeProperties
BlipFillProperties RefId
PicNonVisual
_picShapeProperties :: ShapeProperties
_picBlipFill :: BlipFillProperties RefId
_picNonVisual :: PicNonVisual
_picPublished :: Bool
_picMacro :: Maybe Text
_picShapeProperties :: ShapeProperties
_picBlipFill :: BlipFillProperties RefId
_picNonVisual :: PicNonVisual
_picPublished :: Bool
_picMacro :: Maybe Text
..}
  | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
xdr Text
"graphicFrame" = do
    GraphNonVisual
_grNonVisual <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdr Text
"nvGraphicFramePr") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    Transform2D
_grTransform <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdr Text
"xfrm") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
    RefId
_grChartSpace <-
      Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
a_ Text
"graphic") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
a_ Text
"graphicData") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/
      Name -> Axis
element (Text -> Name
c_ Text
"chart") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RefId
RefId forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Name -> Cursor -> [Text]
attribute (Text -> Name
odr Text
"id")
    forall (m :: * -> *) a. Monad m => a -> m a
return Graphic {RefId
Transform2D
GraphNonVisual
_grChartSpace :: RefId
_grTransform :: Transform2D
_grNonVisual :: GraphNonVisual
_grTransform :: Transform2D
_grChartSpace :: RefId
_grNonVisual :: GraphNonVisual
..}
  | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no matching drawing object node"
  where
    cur :: Cursor
cur = Node -> Cursor
fromNode Node
n

instance FromCursor PicNonVisual where
    fromCursor :: Cursor -> [PicNonVisual]
fromCursor Cursor
cur = do
        NonVisualDrawingProperties
_pnvDrawingProps <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdrText
"cNvPr") 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 PicNonVisual{NonVisualDrawingProperties
_pnvDrawingProps :: NonVisualDrawingProperties
_pnvDrawingProps :: NonVisualDrawingProperties
..}

instance FromCursor GraphNonVisual where
  fromCursor :: Cursor -> [GraphNonVisual]
fromCursor Cursor
cur = do
    NonVisualDrawingProperties
_gnvDrawingProps <- Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xdr Text
"cNvPr") 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 GraphNonVisual {NonVisualDrawingProperties
_gnvDrawingProps :: NonVisualDrawingProperties
_gnvDrawingProps :: NonVisualDrawingProperties
..}

instance FromCursor NonVisualDrawingProperties where
    fromCursor :: Cursor -> [NonVisualDrawingProperties]
fromCursor Cursor
cur = do
        DrawingElementId
_nvdpId <- forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"id" Cursor
cur
        Text
_nvdpName <- forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"name" Cursor
cur
        Maybe Text
_nvdpDescription <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"descr" Cursor
cur
        Bool
_nvdpHidden <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"hidden" Bool
False Cursor
cur
        Maybe Text
_nvdpTitle <- forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"title" Cursor
cur
        forall (m :: * -> *) a. Monad m => a -> m a
return NonVisualDrawingProperties{Bool
Maybe Text
Text
DrawingElementId
_nvdpTitle :: Maybe Text
_nvdpHidden :: Bool
_nvdpDescription :: Maybe Text
_nvdpName :: Text
_nvdpId :: DrawingElementId
_nvdpTitle :: Maybe Text
_nvdpHidden :: Bool
_nvdpDescription :: Maybe Text
_nvdpName :: Text
_nvdpId :: DrawingElementId
..}

instance FromAttrVal DrawingElementId where
  fromAttrVal :: Reader DrawingElementId
fromAttrVal = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> DrawingElementId
DrawingElementId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromAttrVal a => Reader a
fromAttrVal

instance FromCursor (BlipFillProperties RefId) where
    fromCursor :: Cursor -> [BlipFillProperties RefId]
fromCursor Cursor
cur = do
        let _bfpImageInfo :: Maybe RefId
_bfpImageInfo = 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
"blip") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RefId
RefId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Cursor -> [Text]
attribute (Text -> Name
odrText
"embed")
            _bfpFillMode :: Maybe FillMode
_bfpFillMode  = 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
        forall (m :: * -> *) a. Monad m => a -> m a
return BlipFillProperties{Maybe RefId
Maybe FillMode
_bfpFillMode :: Maybe FillMode
_bfpImageInfo :: Maybe RefId
_bfpFillMode :: Maybe FillMode
_bfpImageInfo :: Maybe RefId
..}

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

fillModeFromNode :: Node -> [FillMode]
fillModeFromNode :: Node -> [FillMode]
fillModeFromNode Node
n | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
a_ Text
"stretch" = forall (m :: * -> *) a. Monad m => a -> m a
return FillMode
FillStretch
                   | Node
n Node -> Name -> Bool
`nodeElNameIs` Text -> Name
a_ Text
"stretch" = forall (m :: * -> *) a. Monad m => a -> m a
return FillMode
FillTile
                   | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no matching fill mode node"

-- see 20.5.3.2 "ST_EditAs (Resizing Behaviors)" (p. 3177)
instance FromAttrVal EditAs where
    fromAttrVal :: Reader EditAs
fromAttrVal Text
"absolute" = forall a. a -> Either FilePath (a, Text)
readSuccess EditAs
EditAsAbsolute
    fromAttrVal Text
"oneCell"  = forall a. a -> Either FilePath (a, Text)
readSuccess EditAs
EditAsOneCell
    fromAttrVal Text
"twoCell"  = forall a. a -> Either FilePath (a, Text)
readSuccess EditAs
EditAsTwoCell
    fromAttrVal Text
t          = forall a. Text -> Text -> Either FilePath (a, Text)
invalidText Text
"EditAs" Text
t

instance FromCursor ClientData where
    fromCursor :: Cursor -> [ClientData]
fromCursor Cursor
cur = do
        Bool
_cldLcksWithSheet   <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"fLocksWithSheet"  Bool
True Cursor
cur
        Bool
_cldPrintsWithSheet <- forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"fPrintsWithSheet" Bool
True Cursor
cur
        forall (m :: * -> *) a. Monad m => a -> m a
return ClientData{Bool
_cldPrintsWithSheet :: Bool
_cldLcksWithSheet :: Bool
_cldPrintsWithSheet :: Bool
_cldLcksWithSheet :: Bool
..}

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

instance ToDocument UnresolvedDrawing where
    toDocument :: UnresolvedDrawing -> Document
toDocument = Text -> Text -> Element -> Document
documentFromNsElement Text
"Drawing generated by xlsx" Text
xlDrawingNs
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToElement a => Name -> a -> Element
toElement Name
"wsDr"

instance ToElement UnresolvedDrawing where
    toElement :: Name -> UnresolvedDrawing -> Element
toElement Name
nm (Drawing [Anchor RefId RefId]
anchors) = Element
        { elementName :: Name
elementName       = Name
nm
        , elementAttributes :: Map Name Text
elementAttributes = forall k a. Map k a
M.empty
        , elementNodes :: [Node]
elementNodes      = forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$
                              forall a b. (a -> b) -> [a] -> [b]
map Anchor RefId RefId -> Element
anchorToElement [Anchor RefId RefId]
anchors
        }

anchorToElement :: Anchor RefId RefId -> Element
anchorToElement :: Anchor RefId RefId -> Element
anchorToElement Anchor{ClientData
DrawingObject RefId RefId
Anchoring
_anchClientData :: ClientData
_anchObject :: DrawingObject RefId RefId
_anchAnchoring :: Anchoring
_anchClientData :: forall p g. Anchor p g -> ClientData
_anchObject :: forall p g. Anchor p g -> DrawingObject p g
_anchAnchoring :: forall p g. Anchor p g -> Anchoring
..} = Element
el
    { elementNodes :: [Node]
elementNodes = Element -> [Node]
elementNodes Element
el forall a. [a] -> [a] -> [a]
++
                     forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement [ Element
drawingObjEl, Element
cdEl ] }
  where
    el :: Element
el = Anchoring -> Element
anchoringToElement Anchoring
_anchAnchoring
    drawingObjEl :: Element
drawingObjEl = DrawingObject RefId RefId -> Element
drawingObjToElement DrawingObject RefId RefId
_anchObject
    cdEl :: Element
cdEl = forall a. ToElement a => Name -> a -> Element
toElement Name
"clientData" ClientData
_anchClientData

anchoringToElement :: Anchoring -> Element
anchoringToElement :: Anchoring -> Element
anchoringToElement Anchoring
anchoring = Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
nm [(Name, Text)]
attrs [Element]
elements
  where
    (Name
nm, [(Name, Text)]
attrs, [Element]
elements) = case Anchoring
anchoring of
        AbsoluteAnchor{PositiveSize2D
Point2D
absaExt :: PositiveSize2D
absaPos :: Point2D
absaExt :: Anchoring -> PositiveSize2D
absaPos :: Anchoring -> Point2D
..} ->
            (Name
"absoluteAnchor", [],
             [ forall a. ToElement a => Name -> a -> Element
toElement Name
"pos" Point2D
absaPos, forall a. ToElement a => Name -> a -> Element
toElement Name
"ext" PositiveSize2D
absaExt ])
        OneCellAnchor{PositiveSize2D
Marker
onecaExt :: PositiveSize2D
onecaFrom :: Marker
onecaExt :: Anchoring -> PositiveSize2D
onecaFrom :: Anchoring -> Marker
..}  ->
            (Name
"oneCellAnchor", [],
             [ forall a. ToElement a => Name -> a -> Element
toElement Name
"from" Marker
onecaFrom, forall a. ToElement a => Name -> a -> Element
toElement Name
"ext" PositiveSize2D
onecaExt ])
        TwoCellAnchor{EditAs
Marker
tcaEditAs :: EditAs
tcaTo :: Marker
tcaFrom :: Marker
tcaEditAs :: Anchoring -> EditAs
tcaTo :: Anchoring -> Marker
tcaFrom :: Anchoring -> Marker
..}  ->
            (Name
"twoCellAnchor", [ Name
"editAs" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= EditAs
tcaEditAs ],
             [ forall a. ToElement a => Name -> a -> Element
toElement Name
"from" Marker
tcaFrom, forall a. ToElement a => Name -> a -> Element
toElement Name
"to" Marker
tcaTo ])

instance ToElement Marker where
    toElement :: Name -> Marker -> Element
toElement Name
nm Marker{Int
Coordinate
_mrkRowOff :: Coordinate
_mrkRow :: Int
_mrkColOff :: Coordinate
_mrkCol :: Int
_mrkRowOff :: Marker -> Coordinate
_mrkRow :: Marker -> Int
_mrkColOff :: Marker -> Coordinate
_mrkCol :: Marker -> Int
..} = Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
      where
        elements :: [Element]
elements = [ Name -> Text -> Element
elementContent Name
"col"    (forall a. ToAttrVal a => a -> Text
toAttrVal Int
_mrkCol)
                   , Name -> Text -> Element
elementContent Name
"colOff" (forall a. ToAttrVal a => a -> Text
toAttrVal Coordinate
_mrkColOff)
                   , Name -> Text -> Element
elementContent Name
"row"    (forall a. ToAttrVal a => a -> Text
toAttrVal Int
_mrkRow)
                   , Name -> Text -> Element
elementContent Name
"rowOff" (forall a. ToAttrVal a => a -> Text
toAttrVal Coordinate
_mrkRowOff)]

drawingObjToElement :: DrawingObject RefId RefId -> Element
drawingObjToElement :: DrawingObject RefId RefId -> Element
drawingObjToElement Picture {Bool
Maybe Text
ShapeProperties
BlipFillProperties RefId
PicNonVisual
_picShapeProperties :: ShapeProperties
_picBlipFill :: BlipFillProperties RefId
_picNonVisual :: PicNonVisual
_picPublished :: Bool
_picMacro :: Maybe Text
_picShapeProperties :: forall p g. DrawingObject p g -> ShapeProperties
_picBlipFill :: forall p g. DrawingObject p g -> BlipFillProperties p
_picNonVisual :: forall p g. DrawingObject p g -> PicNonVisual
_picPublished :: forall p g. DrawingObject p g -> Bool
_picMacro :: forall p g. DrawingObject p g -> Maybe Text
..} = Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
"pic" [(Name, Text)]
attrs [Element]
elements
  where
    attrs :: [(Name, Text)]
attrs =
      forall a. [Maybe a] -> [a]
catMaybes [Name
"macro" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_picMacro, Name
"fPublished" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_picPublished]
    elements :: [Element]
elements =
      [ forall a. ToElement a => Name -> a -> Element
toElement Name
"nvPicPr" PicNonVisual
_picNonVisual
      , forall a. ToElement a => Name -> a -> Element
toElement Name
"blipFill" BlipFillProperties RefId
_picBlipFill
      , forall a. ToElement a => Name -> a -> Element
toElement Name
"spPr" ShapeProperties
_picShapeProperties
      ]
drawingObjToElement Graphic {RefId
Transform2D
GraphNonVisual
_grTransform :: Transform2D
_grChartSpace :: RefId
_grNonVisual :: GraphNonVisual
_grTransform :: forall p g. DrawingObject p g -> Transform2D
_grChartSpace :: forall p g. DrawingObject p g -> g
_grNonVisual :: forall p g. DrawingObject p g -> GraphNonVisual
..} = Name -> [Element] -> Element
elementListSimple Name
"graphicFrame" [Element]
elements
  where
    elements :: [Element]
elements =
      [ forall a. ToElement a => Name -> a -> Element
toElement Name
"nvGraphicFramePr" GraphNonVisual
_grNonVisual
      , forall a. ToElement a => Name -> a -> Element
toElement Name
"xfrm" Transform2D
_grTransform
      , Element
graphicEl
      ]
    graphicEl :: Element
graphicEl =
      Name -> [Element] -> Element
elementListSimple
        (Text -> Name
a_ Text
"graphic")
        [ Name -> [(Name, Text)] -> [Element] -> Element
elementList
            (Text -> Name
a_ Text
"graphicData")
            [Name
"uri" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
chartNs]
            [Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
c_ Text
"chart") [Text -> Name
odr Text
"id" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= RefId
_grChartSpace]]
        ]

instance ToElement PicNonVisual where
  toElement :: Name -> PicNonVisual -> Element
toElement Name
nm PicNonVisual {NonVisualDrawingProperties
_pnvDrawingProps :: NonVisualDrawingProperties
_pnvDrawingProps :: PicNonVisual -> NonVisualDrawingProperties
..} =
    Name -> [Element] -> Element
elementListSimple
      Name
nm
      [forall a. ToElement a => Name -> a -> Element
toElement Name
"cNvPr" NonVisualDrawingProperties
_pnvDrawingProps, Name -> Element
emptyElement Name
"cNvPicPr"]

instance ToElement GraphNonVisual where
  toElement :: Name -> GraphNonVisual -> Element
toElement Name
nm GraphNonVisual {NonVisualDrawingProperties
_gnvDrawingProps :: NonVisualDrawingProperties
_gnvDrawingProps :: GraphNonVisual -> NonVisualDrawingProperties
..} =
    Name -> [Element] -> Element
elementListSimple
      Name
nm
      [forall a. ToElement a => Name -> a -> Element
toElement Name
"cNvPr" NonVisualDrawingProperties
_gnvDrawingProps, Name -> Element
emptyElement Name
"cNvGraphicFramePr"]

instance ToElement NonVisualDrawingProperties where
    toElement :: Name -> NonVisualDrawingProperties -> Element
toElement Name
nm NonVisualDrawingProperties{Bool
Maybe Text
Text
DrawingElementId
_nvdpTitle :: Maybe Text
_nvdpHidden :: Bool
_nvdpDescription :: Maybe Text
_nvdpName :: Text
_nvdpId :: DrawingElementId
_nvdpTitle :: NonVisualDrawingProperties -> Maybe Text
_nvdpHidden :: NonVisualDrawingProperties -> Bool
_nvdpDescription :: NonVisualDrawingProperties -> Maybe Text
_nvdpName :: NonVisualDrawingProperties -> Text
_nvdpId :: NonVisualDrawingProperties -> DrawingElementId
..} =
        Name -> [(Name, Text)] -> Element
leafElement Name
nm [(Name, Text)]
attrs
      where
        attrs :: [(Name, Text)]
attrs = [ Name
"id"    forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= DrawingElementId
_nvdpId
                , Name
"name"  forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
_nvdpName ] forall a. [a] -> [a] -> [a]
++
                forall a. [Maybe a] -> [a]
catMaybes [ Name
"descr"  forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_nvdpDescription
                          , Name
"hidden" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justTrue Bool
_nvdpHidden
                          , Name
"title"  forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
_nvdpTitle ]

instance ToAttrVal DrawingElementId where
  toAttrVal :: DrawingElementId -> Text
toAttrVal = forall a. ToAttrVal a => a -> Text
toAttrVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrawingElementId -> Int
unDrawingElementId

instance ToElement (BlipFillProperties RefId) where
    toElement :: Name -> BlipFillProperties RefId -> Element
toElement Name
nm BlipFillProperties{Maybe RefId
Maybe FillMode
_bfpFillMode :: Maybe FillMode
_bfpImageInfo :: Maybe RefId
_bfpFillMode :: forall a. BlipFillProperties a -> Maybe FillMode
_bfpImageInfo :: forall a. BlipFillProperties a -> Maybe a
..} =
        Name -> [Element] -> Element
elementListSimple Name
nm [Element]
elements
      where
        elements :: [Element]
elements = forall a. [Maybe a] -> [a]
catMaybes [ (\RefId
rId -> Name -> [(Name, Text)] -> Element
leafElement (Text -> Name
a_ Text
"blip") [ Text -> Name
odr Text
"embed" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= RefId
rId ]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RefId
_bfpImageInfo
                             , FillMode -> Element
fillModeToElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FillMode
_bfpFillMode ]

fillModeToElement :: FillMode -> Element
fillModeToElement :: FillMode -> Element
fillModeToElement FillMode
FillStretch = Name -> Element
emptyElement (Text -> Name
a_ Text
"stretch")
fillModeToElement FillMode
FillTile    = Name -> Element
emptyElement (Text -> Name
a_ Text
"stretch")

instance ToElement ClientData where
    toElement :: Name -> ClientData -> Element
toElement Name
nm ClientData{Bool
_cldPrintsWithSheet :: Bool
_cldLcksWithSheet :: Bool
_cldPrintsWithSheet :: ClientData -> Bool
_cldLcksWithSheet :: ClientData -> Bool
..} = Name -> [(Name, Text)] -> Element
leafElement Name
nm [(Name, Text)]
attrs
      where
        attrs :: [(Name, Text)]
attrs = forall a. [Maybe a] -> [a]
catMaybes [ Name
"fLocksWithSheet"  forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_cldLcksWithSheet
                          , Name
"fPrintsWithSheet" forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Bool -> Maybe Bool
justFalse Bool
_cldPrintsWithSheet
                          ]

instance ToAttrVal EditAs where
    toAttrVal :: EditAs -> Text
toAttrVal EditAs
EditAsAbsolute = Text
"absolute"
    toAttrVal EditAs
EditAsOneCell  = Text
"oneCell"
    toAttrVal EditAs
EditAsTwoCell  = Text
"twoCell"

-- | Add Spreadsheet DrawingML namespace to name
xdr :: Text -> Name
xdr :: Text -> Name
xdr Text
x = Name
  { nameLocalName :: Text
nameLocalName = Text
x
  , nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
xlDrawingNs
  , namePrefix :: Maybe Text
namePrefix = forall a. Maybe a
Nothing
  }

xlDrawingNs :: Text
xlDrawingNs :: Text
xlDrawingNs = Text
"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing"