{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.SheetViews (
    -- * Structured type to construct 'SheetViews'
    SheetView(..)
  , Selection(..)
  , Pane(..)
  , SheetViewType(..)
  , PaneType(..)
  , PaneState(..)
    -- * Lenses
    -- ** SheetView
  , sheetViewColorId
  , sheetViewDefaultGridColor
  , sheetViewRightToLeft
  , sheetViewShowFormulas
  , sheetViewShowGridLines
  , sheetViewShowOutlineSymbols
  , sheetViewShowRowColHeaders
  , sheetViewShowRuler
  , sheetViewShowWhiteSpace
  , sheetViewShowZeros
  , sheetViewTabSelected
  , sheetViewTopLeftCell
  , sheetViewType
  , sheetViewWindowProtection
  , sheetViewWorkbookViewId
  , sheetViewZoomScale
  , sheetViewZoomScaleNormal
  , sheetViewZoomScalePageLayoutView
  , sheetViewZoomScaleSheetLayoutView
  , sheetViewPane
  , sheetViewSelection
    -- ** Selection
  , selectionActiveCell
  , selectionActiveCellId
  , selectionPane
  , selectionSqref
    -- ** Pane
  , paneActivePane
  , paneState
  , paneTopLeftCell
  , paneXSplit
  , paneYSplit
  ) where

import GHC.Generics (Generic)

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

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

{-------------------------------------------------------------------------------
  Main types
-------------------------------------------------------------------------------}

-- | Worksheet view
--
-- A single sheet view definition. When more than one sheet view is defined in
-- the file, it means that when opening the workbook, each sheet view
-- corresponds to a separate window within the spreadsheet application, where
-- each window is showing the particular sheet containing the same
-- workbookViewId value, the last sheetView definition is loaded, and the others
-- are discarded. When multiple windows are viewing the same sheet, multiple
-- sheetView elements (with corresponding workbookView entries) are saved.
--
-- TODO: The @pivotSelection@ and @extLst@ child elements are unsupported.
--
-- See Section 18.3.1.87 "sheetView (Worksheet View)" (p. 1880)
data SheetView = SheetView {
    -- | Index to the color value for row/column text headings and gridlines.
    -- This is an 'index color value' (ICV) rather than rgb value.
    SheetView -> Maybe Int
_sheetViewColorId :: Maybe Int

    -- | Flag indicating that the consuming application should use the default
    -- grid lines color (system dependent). Overrides any color specified in
    -- colorId.
  , SheetView -> Maybe Bool
_sheetViewDefaultGridColor :: Maybe Bool

    -- | Flag indicating whether the sheet is in 'right to left' display mode.
    -- When in this mode, Column A is on the far right, Column B ;is one column
    -- left of Column A, and so on. Also, information in cells is displayed in
    -- the Right to Left format.
  , SheetView -> Maybe Bool
_sheetViewRightToLeft :: Maybe Bool

    -- | Flag indicating whether this sheet should display formulas.
  , SheetView -> Maybe Bool
_sheetViewShowFormulas :: Maybe Bool

    -- | Flag indicating whether this sheet should display gridlines.
  , SheetView -> Maybe Bool
_sheetViewShowGridLines :: Maybe Bool

    -- | Flag indicating whether the sheet has outline symbols visible. This
    -- flag shall always override SheetPr element's outlinePr child element
    -- whose attribute is named showOutlineSymbols when there is a conflict.
  , SheetView -> Maybe Bool
_sheetViewShowOutlineSymbols :: Maybe Bool

    -- | Flag indicating whether the sheet should display row and column headings.
  , SheetView -> Maybe Bool
_sheetViewShowRowColHeaders :: Maybe Bool

    -- | Show the ruler in Page Layout View.
  , SheetView -> Maybe Bool
_sheetViewShowRuler :: Maybe Bool

    -- | Flag indicating whether page layout view shall display margins. False
    -- means do not display left, right, top (header), and bottom (footer)
    -- margins (even when there is data in the header or footer).
  , SheetView -> Maybe Bool
_sheetViewShowWhiteSpace :: Maybe Bool

    -- | Flag indicating whether the window should show 0 (zero) in cells
    -- containing zero value. When false, cells with zero value appear blank
    -- instead of showing the number zero.
  , SheetView -> Maybe Bool
_sheetViewShowZeros :: Maybe Bool

    -- | Flag indicating whether this sheet is selected. When only 1 sheet is
    -- selected and active, this value should be in synch with the activeTab
    -- value. In case of a conflict, the Start Part setting wins and sets the
    -- active sheet tab.
    --
    -- Multiple sheets can be selected, but only one sheet shall be active at
    -- one time.
  , SheetView -> Maybe Bool
_sheetViewTabSelected :: Maybe Bool

    -- | Location of the top left visible cell Location of the top left visible
    -- cell in the bottom right pane (when in Left-to-Right mode).
  , SheetView -> Maybe CellRef
_sheetViewTopLeftCell :: Maybe CellRef

    -- | Indicates the view type.
  , SheetView -> Maybe SheetViewType
_sheetViewType :: Maybe SheetViewType

    -- | Flag indicating whether the panes in the window are locked due to
    -- workbook protection. This is an option when the workbook structure is
    -- protected.
  , SheetView -> Maybe Bool
_sheetViewWindowProtection :: Maybe Bool

    -- | Zero-based index of this workbook view, pointing to a workbookView
    -- element in the bookViews collection.
    --
    -- NOTE: This attribute is required.
  , SheetView -> Int
_sheetViewWorkbookViewId :: Int

    -- | Window zoom magnification for current view representing percent values.
    -- This attribute is restricted to values ranging from 10 to 400. Horizontal &
    -- Vertical scale together.
  , SheetView -> Maybe Int
_sheetViewZoomScale :: Maybe Int

    -- | Zoom magnification to use when in normal view, representing percent
    -- values. This attribute is restricted to values ranging from 10 to 400.
    -- Horizontal & Vertical scale together.
  , SheetView -> Maybe Int
_sheetViewZoomScaleNormal :: Maybe Int

    -- | Zoom magnification to use when in page layout view, representing
    -- percent values. This attribute is restricted to values ranging from 10 to
    -- 400. Horizontal & Vertical scale together.
  , SheetView -> Maybe Int
_sheetViewZoomScalePageLayoutView :: Maybe Int

    -- | Zoom magnification to use when in page break preview, representing
    -- percent values. This attribute is restricted to values ranging from 10 to
    -- 400. Horizontal & Vertical scale together.
  , SheetView -> Maybe Int
_sheetViewZoomScaleSheetLayoutView :: Maybe Int

    -- | Worksheet view pane
  , SheetView -> Maybe Pane
_sheetViewPane :: Maybe Pane

    -- | Worksheet view selection
    --
    -- Minimum of 0, maximum of 4 elements
  , SheetView -> [Selection]
_sheetViewSelection :: [Selection]
  }
  deriving (SheetView -> SheetView -> Bool
(SheetView -> SheetView -> Bool)
-> (SheetView -> SheetView -> Bool) -> Eq SheetView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SheetView -> SheetView -> Bool
$c/= :: SheetView -> SheetView -> Bool
== :: SheetView -> SheetView -> Bool
$c== :: SheetView -> SheetView -> Bool
Eq, Eq SheetView
Eq SheetView
-> (SheetView -> SheetView -> Ordering)
-> (SheetView -> SheetView -> Bool)
-> (SheetView -> SheetView -> Bool)
-> (SheetView -> SheetView -> Bool)
-> (SheetView -> SheetView -> Bool)
-> (SheetView -> SheetView -> SheetView)
-> (SheetView -> SheetView -> SheetView)
-> Ord SheetView
SheetView -> SheetView -> Bool
SheetView -> SheetView -> Ordering
SheetView -> SheetView -> SheetView
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 :: SheetView -> SheetView -> SheetView
$cmin :: SheetView -> SheetView -> SheetView
max :: SheetView -> SheetView -> SheetView
$cmax :: SheetView -> SheetView -> SheetView
>= :: SheetView -> SheetView -> Bool
$c>= :: SheetView -> SheetView -> Bool
> :: SheetView -> SheetView -> Bool
$c> :: SheetView -> SheetView -> Bool
<= :: SheetView -> SheetView -> Bool
$c<= :: SheetView -> SheetView -> Bool
< :: SheetView -> SheetView -> Bool
$c< :: SheetView -> SheetView -> Bool
compare :: SheetView -> SheetView -> Ordering
$ccompare :: SheetView -> SheetView -> Ordering
$cp1Ord :: Eq SheetView
Ord, Int -> SheetView -> ShowS
[SheetView] -> ShowS
SheetView -> String
(Int -> SheetView -> ShowS)
-> (SheetView -> String)
-> ([SheetView] -> ShowS)
-> Show SheetView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SheetView] -> ShowS
$cshowList :: [SheetView] -> ShowS
show :: SheetView -> String
$cshow :: SheetView -> String
showsPrec :: Int -> SheetView -> ShowS
$cshowsPrec :: Int -> SheetView -> ShowS
Show, (forall x. SheetView -> Rep SheetView x)
-> (forall x. Rep SheetView x -> SheetView) -> Generic SheetView
forall x. Rep SheetView x -> SheetView
forall x. SheetView -> Rep SheetView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SheetView x -> SheetView
$cfrom :: forall x. SheetView -> Rep SheetView x
Generic)
instance NFData SheetView

-- | Worksheet view selection.
--
-- Section 18.3.1.78 "selection (Selection)" (p. 1864)
data Selection = Selection {
    -- | Location of the active cell
    Selection -> Maybe CellRef
_selectionActiveCell :: Maybe CellRef

    -- | 0-based index of the range reference (in the array of references listed
    -- in sqref) containing the active cell. Only used when the selection in
    -- sqref is not contiguous. Therefore, this value needs to be aware of the
    -- order in which the range references are written in sqref.
    --
    -- When this value is out of range then activeCell can be used.
  , Selection -> Maybe Int
_selectionActiveCellId :: Maybe Int

    -- | The pane to which this selection belongs.
  , Selection -> Maybe PaneType
_selectionPane :: Maybe PaneType

    -- | Range of the selection. Can be non-contiguous set of ranges.
  , Selection -> Maybe SqRef
_selectionSqref :: Maybe SqRef
  }
  deriving (Selection -> Selection -> Bool
(Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool) -> Eq Selection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c== :: Selection -> Selection -> Bool
Eq, Eq Selection
Eq Selection
-> (Selection -> Selection -> Ordering)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Selection)
-> (Selection -> Selection -> Selection)
-> Ord Selection
Selection -> Selection -> Bool
Selection -> Selection -> Ordering
Selection -> Selection -> Selection
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 :: Selection -> Selection -> Selection
$cmin :: Selection -> Selection -> Selection
max :: Selection -> Selection -> Selection
$cmax :: Selection -> Selection -> Selection
>= :: Selection -> Selection -> Bool
$c>= :: Selection -> Selection -> Bool
> :: Selection -> Selection -> Bool
$c> :: Selection -> Selection -> Bool
<= :: Selection -> Selection -> Bool
$c<= :: Selection -> Selection -> Bool
< :: Selection -> Selection -> Bool
$c< :: Selection -> Selection -> Bool
compare :: Selection -> Selection -> Ordering
$ccompare :: Selection -> Selection -> Ordering
$cp1Ord :: Eq Selection
Ord, Int -> Selection -> ShowS
[Selection] -> ShowS
Selection -> String
(Int -> Selection -> ShowS)
-> (Selection -> String)
-> ([Selection] -> ShowS)
-> Show Selection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selection] -> ShowS
$cshowList :: [Selection] -> ShowS
show :: Selection -> String
$cshow :: Selection -> String
showsPrec :: Int -> Selection -> ShowS
$cshowsPrec :: Int -> Selection -> ShowS
Show, (forall x. Selection -> Rep Selection x)
-> (forall x. Rep Selection x -> Selection) -> Generic Selection
forall x. Rep Selection x -> Selection
forall x. Selection -> Rep Selection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Selection x -> Selection
$cfrom :: forall x. Selection -> Rep Selection x
Generic)
instance NFData Selection

-- | Worksheet view pane
--
-- Section 18.3.1.66 "pane (View Pane)" (p. 1843)
data Pane = Pane {
    -- | The pane that is active.
    Pane -> Maybe PaneType
_paneActivePane :: Maybe PaneType

    -- | Indicates whether the pane has horizontal / vertical splits, and
    -- whether those splits are frozen.
  , Pane -> Maybe PaneState
_paneState :: Maybe PaneState

    -- | Location of the top left visible cell in the bottom right pane (when in
    -- Left-To-Right mode).
  , Pane -> Maybe CellRef
_paneTopLeftCell :: Maybe CellRef

    -- | Horizontal position of the split, in 1/20th of a point; 0 (zero) if
    -- none. If the pane is frozen, this value indicates the number of columns
    -- visible in the top pane.
  , Pane -> Maybe Double
_paneXSplit :: Maybe Double

    -- | Vertical position of the split, in 1/20th of a point; 0 (zero) if none.
    -- If the pane is frozen, this value indicates the number of rows visible in
    -- the left pane.
  , Pane -> Maybe Double
_paneYSplit :: Maybe Double
  }
  deriving (Pane -> Pane -> Bool
(Pane -> Pane -> Bool) -> (Pane -> Pane -> Bool) -> Eq Pane
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pane -> Pane -> Bool
$c/= :: Pane -> Pane -> Bool
== :: Pane -> Pane -> Bool
$c== :: Pane -> Pane -> Bool
Eq, Eq Pane
Eq Pane
-> (Pane -> Pane -> Ordering)
-> (Pane -> Pane -> Bool)
-> (Pane -> Pane -> Bool)
-> (Pane -> Pane -> Bool)
-> (Pane -> Pane -> Bool)
-> (Pane -> Pane -> Pane)
-> (Pane -> Pane -> Pane)
-> Ord Pane
Pane -> Pane -> Bool
Pane -> Pane -> Ordering
Pane -> Pane -> Pane
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 :: Pane -> Pane -> Pane
$cmin :: Pane -> Pane -> Pane
max :: Pane -> Pane -> Pane
$cmax :: Pane -> Pane -> Pane
>= :: Pane -> Pane -> Bool
$c>= :: Pane -> Pane -> Bool
> :: Pane -> Pane -> Bool
$c> :: Pane -> Pane -> Bool
<= :: Pane -> Pane -> Bool
$c<= :: Pane -> Pane -> Bool
< :: Pane -> Pane -> Bool
$c< :: Pane -> Pane -> Bool
compare :: Pane -> Pane -> Ordering
$ccompare :: Pane -> Pane -> Ordering
$cp1Ord :: Eq Pane
Ord, Int -> Pane -> ShowS
[Pane] -> ShowS
Pane -> String
(Int -> Pane -> ShowS)
-> (Pane -> String) -> ([Pane] -> ShowS) -> Show Pane
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pane] -> ShowS
$cshowList :: [Pane] -> ShowS
show :: Pane -> String
$cshow :: Pane -> String
showsPrec :: Int -> Pane -> ShowS
$cshowsPrec :: Int -> Pane -> ShowS
Show, (forall x. Pane -> Rep Pane x)
-> (forall x. Rep Pane x -> Pane) -> Generic Pane
forall x. Rep Pane x -> Pane
forall x. Pane -> Rep Pane x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pane x -> Pane
$cfrom :: forall x. Pane -> Rep Pane x
Generic)
instance NFData Pane

{-------------------------------------------------------------------------------
  Enumerations
-------------------------------------------------------------------------------}

-- | View setting of the sheet
--
-- Section 18.18.69 "ST_SheetViewType (Sheet View Type)" (p. 2726)
data SheetViewType =
    -- | Normal view
    SheetViewTypeNormal

    -- | Page break preview
  | SheetViewTypePageBreakPreview

    -- | Page layout view
  | SheetViewTypePageLayout
  deriving (SheetViewType -> SheetViewType -> Bool
(SheetViewType -> SheetViewType -> Bool)
-> (SheetViewType -> SheetViewType -> Bool) -> Eq SheetViewType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SheetViewType -> SheetViewType -> Bool
$c/= :: SheetViewType -> SheetViewType -> Bool
== :: SheetViewType -> SheetViewType -> Bool
$c== :: SheetViewType -> SheetViewType -> Bool
Eq, Eq SheetViewType
Eq SheetViewType
-> (SheetViewType -> SheetViewType -> Ordering)
-> (SheetViewType -> SheetViewType -> Bool)
-> (SheetViewType -> SheetViewType -> Bool)
-> (SheetViewType -> SheetViewType -> Bool)
-> (SheetViewType -> SheetViewType -> Bool)
-> (SheetViewType -> SheetViewType -> SheetViewType)
-> (SheetViewType -> SheetViewType -> SheetViewType)
-> Ord SheetViewType
SheetViewType -> SheetViewType -> Bool
SheetViewType -> SheetViewType -> Ordering
SheetViewType -> SheetViewType -> SheetViewType
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 :: SheetViewType -> SheetViewType -> SheetViewType
$cmin :: SheetViewType -> SheetViewType -> SheetViewType
max :: SheetViewType -> SheetViewType -> SheetViewType
$cmax :: SheetViewType -> SheetViewType -> SheetViewType
>= :: SheetViewType -> SheetViewType -> Bool
$c>= :: SheetViewType -> SheetViewType -> Bool
> :: SheetViewType -> SheetViewType -> Bool
$c> :: SheetViewType -> SheetViewType -> Bool
<= :: SheetViewType -> SheetViewType -> Bool
$c<= :: SheetViewType -> SheetViewType -> Bool
< :: SheetViewType -> SheetViewType -> Bool
$c< :: SheetViewType -> SheetViewType -> Bool
compare :: SheetViewType -> SheetViewType -> Ordering
$ccompare :: SheetViewType -> SheetViewType -> Ordering
$cp1Ord :: Eq SheetViewType
Ord, Int -> SheetViewType -> ShowS
[SheetViewType] -> ShowS
SheetViewType -> String
(Int -> SheetViewType -> ShowS)
-> (SheetViewType -> String)
-> ([SheetViewType] -> ShowS)
-> Show SheetViewType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SheetViewType] -> ShowS
$cshowList :: [SheetViewType] -> ShowS
show :: SheetViewType -> String
$cshow :: SheetViewType -> String
showsPrec :: Int -> SheetViewType -> ShowS
$cshowsPrec :: Int -> SheetViewType -> ShowS
Show, (forall x. SheetViewType -> Rep SheetViewType x)
-> (forall x. Rep SheetViewType x -> SheetViewType)
-> Generic SheetViewType
forall x. Rep SheetViewType x -> SheetViewType
forall x. SheetViewType -> Rep SheetViewType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SheetViewType x -> SheetViewType
$cfrom :: forall x. SheetViewType -> Rep SheetViewType x
Generic)
instance NFData SheetViewType

-- | Pane type
--
-- Section 18.18.52 "ST_Pane (Pane Types)" (p. 2710)
data PaneType =
    -- | Bottom left pane, when both vertical and horizontal splits are applied.
    --
    -- This value is also used when only a horizontal split has been applied,
    -- dividing the pane into upper and lower regions. In that case, this value
    -- specifies the bottom pane.
    PaneTypeBottomLeft

    -- Bottom right pane, when both vertical and horizontal splits are applied.
  | PaneTypeBottomRight

    -- | Top left pane, when both vertical and horizontal splits are applied.
    --
    -- This value is also used when only a horizontal split has been applied,
    -- dividing the pane into upper and lower regions. In that case, this value
    -- specifies the top pane.
    --
    -- This value is also used when only a vertical split has been applied,
    -- dividing the pane into right and left regions. In that case, this value
    -- specifies the left pane
  | PaneTypeTopLeft

    -- | Top right pane, when both vertical and horizontal splits are applied.
    --
    -- This value is also used when only a vertical split has been applied,
    -- dividing the pane into right and left regions. In that case, this value
    -- specifies the right pane.
  | PaneTypeTopRight
  deriving (PaneType -> PaneType -> Bool
(PaneType -> PaneType -> Bool)
-> (PaneType -> PaneType -> Bool) -> Eq PaneType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaneType -> PaneType -> Bool
$c/= :: PaneType -> PaneType -> Bool
== :: PaneType -> PaneType -> Bool
$c== :: PaneType -> PaneType -> Bool
Eq, Eq PaneType
Eq PaneType
-> (PaneType -> PaneType -> Ordering)
-> (PaneType -> PaneType -> Bool)
-> (PaneType -> PaneType -> Bool)
-> (PaneType -> PaneType -> Bool)
-> (PaneType -> PaneType -> Bool)
-> (PaneType -> PaneType -> PaneType)
-> (PaneType -> PaneType -> PaneType)
-> Ord PaneType
PaneType -> PaneType -> Bool
PaneType -> PaneType -> Ordering
PaneType -> PaneType -> PaneType
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 :: PaneType -> PaneType -> PaneType
$cmin :: PaneType -> PaneType -> PaneType
max :: PaneType -> PaneType -> PaneType
$cmax :: PaneType -> PaneType -> PaneType
>= :: PaneType -> PaneType -> Bool
$c>= :: PaneType -> PaneType -> Bool
> :: PaneType -> PaneType -> Bool
$c> :: PaneType -> PaneType -> Bool
<= :: PaneType -> PaneType -> Bool
$c<= :: PaneType -> PaneType -> Bool
< :: PaneType -> PaneType -> Bool
$c< :: PaneType -> PaneType -> Bool
compare :: PaneType -> PaneType -> Ordering
$ccompare :: PaneType -> PaneType -> Ordering
$cp1Ord :: Eq PaneType
Ord, Int -> PaneType -> ShowS
[PaneType] -> ShowS
PaneType -> String
(Int -> PaneType -> ShowS)
-> (PaneType -> String) -> ([PaneType] -> ShowS) -> Show PaneType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaneType] -> ShowS
$cshowList :: [PaneType] -> ShowS
show :: PaneType -> String
$cshow :: PaneType -> String
showsPrec :: Int -> PaneType -> ShowS
$cshowsPrec :: Int -> PaneType -> ShowS
Show, (forall x. PaneType -> Rep PaneType x)
-> (forall x. Rep PaneType x -> PaneType) -> Generic PaneType
forall x. Rep PaneType x -> PaneType
forall x. PaneType -> Rep PaneType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PaneType x -> PaneType
$cfrom :: forall x. PaneType -> Rep PaneType x
Generic)
instance NFData PaneType

-- | State of the sheet's pane.
--
-- Section 18.18.53 "ST_PaneState (Pane State)" (p. 2711)
data PaneState =
    -- | Panes are frozen, but were not split being frozen. In this state, when
    -- the panes are unfrozen again, a single pane results, with no split. In
    -- this state, the split bars are not adjustable.
    PaneStateFrozen

    -- | Panes are frozen and were split before being frozen. In this state,
    -- when the panes are unfrozen again, the split remains, but is adjustable.
  | PaneStateFrozenSplit

    -- | Panes are split, but not frozen. In this state, the split bars are
    -- adjustable by the user.
  | PaneStateSplit
  deriving (PaneState -> PaneState -> Bool
(PaneState -> PaneState -> Bool)
-> (PaneState -> PaneState -> Bool) -> Eq PaneState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaneState -> PaneState -> Bool
$c/= :: PaneState -> PaneState -> Bool
== :: PaneState -> PaneState -> Bool
$c== :: PaneState -> PaneState -> Bool
Eq, Eq PaneState
Eq PaneState
-> (PaneState -> PaneState -> Ordering)
-> (PaneState -> PaneState -> Bool)
-> (PaneState -> PaneState -> Bool)
-> (PaneState -> PaneState -> Bool)
-> (PaneState -> PaneState -> Bool)
-> (PaneState -> PaneState -> PaneState)
-> (PaneState -> PaneState -> PaneState)
-> Ord PaneState
PaneState -> PaneState -> Bool
PaneState -> PaneState -> Ordering
PaneState -> PaneState -> PaneState
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 :: PaneState -> PaneState -> PaneState
$cmin :: PaneState -> PaneState -> PaneState
max :: PaneState -> PaneState -> PaneState
$cmax :: PaneState -> PaneState -> PaneState
>= :: PaneState -> PaneState -> Bool
$c>= :: PaneState -> PaneState -> Bool
> :: PaneState -> PaneState -> Bool
$c> :: PaneState -> PaneState -> Bool
<= :: PaneState -> PaneState -> Bool
$c<= :: PaneState -> PaneState -> Bool
< :: PaneState -> PaneState -> Bool
$c< :: PaneState -> PaneState -> Bool
compare :: PaneState -> PaneState -> Ordering
$ccompare :: PaneState -> PaneState -> Ordering
$cp1Ord :: Eq PaneState
Ord, Int -> PaneState -> ShowS
[PaneState] -> ShowS
PaneState -> String
(Int -> PaneState -> ShowS)
-> (PaneState -> String)
-> ([PaneState] -> ShowS)
-> Show PaneState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaneState] -> ShowS
$cshowList :: [PaneState] -> ShowS
show :: PaneState -> String
$cshow :: PaneState -> String
showsPrec :: Int -> PaneState -> ShowS
$cshowsPrec :: Int -> PaneState -> ShowS
Show, (forall x. PaneState -> Rep PaneState x)
-> (forall x. Rep PaneState x -> PaneState) -> Generic PaneState
forall x. Rep PaneState x -> PaneState
forall x. PaneState -> Rep PaneState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PaneState x -> PaneState
$cfrom :: forall x. PaneState -> Rep PaneState x
Generic)
instance NFData PaneState

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

makeLenses ''SheetView
makeLenses ''Selection
makeLenses ''Pane

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

-- | NOTE: The 'Default' instance for 'SheetView' sets the required attribute
-- '_sheetViewWorkbookViewId' to @0@.
instance Default SheetView where
  def :: SheetView
def = SheetView :: Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe CellRef
-> Maybe SheetViewType
-> Maybe Bool
-> Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Pane
-> [Selection]
-> SheetView
SheetView {
      _sheetViewColorId :: Maybe Int
_sheetViewColorId                  = Maybe Int
forall a. Maybe a
Nothing
    , _sheetViewDefaultGridColor :: Maybe Bool
_sheetViewDefaultGridColor         = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewRightToLeft :: Maybe Bool
_sheetViewRightToLeft              = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewShowFormulas :: Maybe Bool
_sheetViewShowFormulas             = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewShowGridLines :: Maybe Bool
_sheetViewShowGridLines            = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewShowOutlineSymbols :: Maybe Bool
_sheetViewShowOutlineSymbols       = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewShowRowColHeaders :: Maybe Bool
_sheetViewShowRowColHeaders        = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewShowRuler :: Maybe Bool
_sheetViewShowRuler                = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewShowWhiteSpace :: Maybe Bool
_sheetViewShowWhiteSpace           = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewShowZeros :: Maybe Bool
_sheetViewShowZeros                = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewTabSelected :: Maybe Bool
_sheetViewTabSelected              = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewTopLeftCell :: Maybe CellRef
_sheetViewTopLeftCell              = Maybe CellRef
forall a. Maybe a
Nothing
    , _sheetViewType :: Maybe SheetViewType
_sheetViewType                     = Maybe SheetViewType
forall a. Maybe a
Nothing
    , _sheetViewWindowProtection :: Maybe Bool
_sheetViewWindowProtection         = Maybe Bool
forall a. Maybe a
Nothing
    , _sheetViewWorkbookViewId :: Int
_sheetViewWorkbookViewId           = Int
0
    , _sheetViewZoomScale :: Maybe Int
_sheetViewZoomScale                = Maybe Int
forall a. Maybe a
Nothing
    , _sheetViewZoomScaleNormal :: Maybe Int
_sheetViewZoomScaleNormal          = Maybe Int
forall a. Maybe a
Nothing
    , _sheetViewZoomScalePageLayoutView :: Maybe Int
_sheetViewZoomScalePageLayoutView  = Maybe Int
forall a. Maybe a
Nothing
    , _sheetViewZoomScaleSheetLayoutView :: Maybe Int
_sheetViewZoomScaleSheetLayoutView = Maybe Int
forall a. Maybe a
Nothing
    , _sheetViewPane :: Maybe Pane
_sheetViewPane                     = Maybe Pane
forall a. Maybe a
Nothing
    , _sheetViewSelection :: [Selection]
_sheetViewSelection                = []
    }

instance Default Selection where
  def :: Selection
def = Selection :: Maybe CellRef
-> Maybe Int -> Maybe PaneType -> Maybe SqRef -> Selection
Selection {
      _selectionActiveCell :: Maybe CellRef
_selectionActiveCell   = Maybe CellRef
forall a. Maybe a
Nothing
    , _selectionActiveCellId :: Maybe Int
_selectionActiveCellId = Maybe Int
forall a. Maybe a
Nothing
    , _selectionPane :: Maybe PaneType
_selectionPane         = Maybe PaneType
forall a. Maybe a
Nothing
    , _selectionSqref :: Maybe SqRef
_selectionSqref        = Maybe SqRef
forall a. Maybe a
Nothing
    }

instance Default Pane where
  def :: Pane
def = Pane :: Maybe PaneType
-> Maybe PaneState
-> Maybe CellRef
-> Maybe Double
-> Maybe Double
-> Pane
Pane {
      _paneActivePane :: Maybe PaneType
_paneActivePane  = Maybe PaneType
forall a. Maybe a
Nothing
    , _paneState :: Maybe PaneState
_paneState       = Maybe PaneState
forall a. Maybe a
Nothing
    , _paneTopLeftCell :: Maybe CellRef
_paneTopLeftCell = Maybe CellRef
forall a. Maybe a
Nothing
    , _paneXSplit :: Maybe Double
_paneXSplit      = Maybe Double
forall a. Maybe a
Nothing
    , _paneYSplit :: Maybe Double
_paneYSplit      = Maybe Double
forall a. Maybe a
Nothing
    }

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

-- | See @CT_SheetView@, p. 3913
instance ToElement SheetView where
  toElement :: Name -> SheetView -> Element
toElement Name
nm SheetView{Int
[Selection]
Maybe Bool
Maybe Int
Maybe CellRef
Maybe SheetViewType
Maybe Pane
_sheetViewSelection :: [Selection]
_sheetViewPane :: Maybe Pane
_sheetViewZoomScaleSheetLayoutView :: Maybe Int
_sheetViewZoomScalePageLayoutView :: Maybe Int
_sheetViewZoomScaleNormal :: Maybe Int
_sheetViewZoomScale :: Maybe Int
_sheetViewWorkbookViewId :: Int
_sheetViewWindowProtection :: Maybe Bool
_sheetViewType :: Maybe SheetViewType
_sheetViewTopLeftCell :: Maybe CellRef
_sheetViewTabSelected :: Maybe Bool
_sheetViewShowZeros :: Maybe Bool
_sheetViewShowWhiteSpace :: Maybe Bool
_sheetViewShowRuler :: Maybe Bool
_sheetViewShowRowColHeaders :: Maybe Bool
_sheetViewShowOutlineSymbols :: Maybe Bool
_sheetViewShowGridLines :: Maybe Bool
_sheetViewShowFormulas :: Maybe Bool
_sheetViewRightToLeft :: Maybe Bool
_sheetViewDefaultGridColor :: Maybe Bool
_sheetViewColorId :: Maybe Int
_sheetViewSelection :: SheetView -> [Selection]
_sheetViewPane :: SheetView -> Maybe Pane
_sheetViewZoomScaleSheetLayoutView :: SheetView -> Maybe Int
_sheetViewZoomScalePageLayoutView :: SheetView -> Maybe Int
_sheetViewZoomScaleNormal :: SheetView -> Maybe Int
_sheetViewZoomScale :: SheetView -> Maybe Int
_sheetViewWorkbookViewId :: SheetView -> Int
_sheetViewWindowProtection :: SheetView -> Maybe Bool
_sheetViewType :: SheetView -> Maybe SheetViewType
_sheetViewTopLeftCell :: SheetView -> Maybe CellRef
_sheetViewTabSelected :: SheetView -> Maybe Bool
_sheetViewShowZeros :: SheetView -> Maybe Bool
_sheetViewShowWhiteSpace :: SheetView -> Maybe Bool
_sheetViewShowRuler :: SheetView -> Maybe Bool
_sheetViewShowRowColHeaders :: SheetView -> Maybe Bool
_sheetViewShowOutlineSymbols :: SheetView -> Maybe Bool
_sheetViewShowGridLines :: SheetView -> Maybe Bool
_sheetViewShowFormulas :: SheetView -> Maybe Bool
_sheetViewRightToLeft :: SheetView -> Maybe Bool
_sheetViewDefaultGridColor :: SheetView -> Maybe Bool
_sheetViewColorId :: SheetView -> Maybe Int
..} = Element :: Name -> Map Name Text -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([[Element]] -> [Element]) -> [[Element]] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Element]] -> [Node]) -> [[Element]] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          (Pane -> Element) -> [Pane] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Pane -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"pane")      (Maybe Pane -> [Pane]
forall a. Maybe a -> [a]
maybeToList Maybe Pane
_sheetViewPane)
        , (Selection -> Element) -> [Selection] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Selection -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"selection") [Selection]
_sheetViewSelection
          -- TODO: pivotSelection
          -- TODO: extLst
        ]
    , elementAttributes :: Map Name Text
elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, Text)] -> Map Name Text)
-> ([Maybe (Name, Text)] -> [(Name, Text)])
-> [Maybe (Name, Text)]
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, Text)] -> Map Name Text)
-> [Maybe (Name, Text)] -> Map Name Text
forall a b. (a -> b) -> a -> b
$ [
          Name
"windowProtection"         Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewWindowProtection
        , Name
"showFormulas"             Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewShowFormulas
        , Name
"showGridLines"            Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewShowGridLines
        , Name
"showRowColHeaders"        Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewShowRowColHeaders
        , Name
"showZeros"                Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewShowZeros
        , Name
"rightToLeft"              Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewRightToLeft
        , Name
"tabSelected"              Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewTabSelected
        , Name
"showRuler"                Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewShowRuler
        , Name
"showOutlineSymbols"       Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewShowOutlineSymbols
        , Name
"defaultGridColor"         Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewDefaultGridColor
        , Name
"showWhiteSpace"           Name -> Maybe Bool -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Bool
_sheetViewShowWhiteSpace
        , Name
"view"                     Name -> Maybe SheetViewType -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe SheetViewType
_sheetViewType
        , Name
"topLeftCell"              Name -> Maybe CellRef -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe CellRef
_sheetViewTopLeftCell
        , Name
"colorId"                  Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
_sheetViewColorId
        , Name
"zoomScale"                Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
_sheetViewZoomScale
        , Name
"zoomScaleNormal"          Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
_sheetViewZoomScaleNormal
        , Name
"zoomScaleSheetLayoutView" Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
_sheetViewZoomScaleSheetLayoutView
        , Name
"zoomScalePageLayoutView"  Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
_sheetViewZoomScalePageLayoutView
        , (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ Name
"workbookViewId"    Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.=  Int
_sheetViewWorkbookViewId
        ]
    }

-- | See @CT_Selection@, p. 3914
instance ToElement Selection where
  toElement :: Name -> Selection -> Element
toElement Name
nm Selection{Maybe Int
Maybe SqRef
Maybe CellRef
Maybe PaneType
_selectionSqref :: Maybe SqRef
_selectionPane :: Maybe PaneType
_selectionActiveCellId :: Maybe Int
_selectionActiveCell :: Maybe CellRef
_selectionSqref :: Selection -> Maybe SqRef
_selectionPane :: Selection -> Maybe PaneType
_selectionActiveCellId :: Selection -> Maybe Int
_selectionActiveCell :: Selection -> Maybe CellRef
..} = Element :: Name -> Map Name Text -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementNodes :: [Node]
elementNodes      = []
    , elementAttributes :: Map Name Text
elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, Text)] -> Map Name Text)
-> ([Maybe (Name, Text)] -> [(Name, Text)])
-> [Maybe (Name, Text)]
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, Text)] -> Map Name Text)
-> [Maybe (Name, Text)] -> Map Name Text
forall a b. (a -> b) -> a -> b
$ [
          Name
"pane"         Name -> Maybe PaneType -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe PaneType
_selectionPane
        , Name
"activeCell"   Name -> Maybe CellRef -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe CellRef
_selectionActiveCell
        , Name
"activeCellId" Name -> Maybe Int -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Int
_selectionActiveCellId
        , Name
"sqref"        Name -> Maybe SqRef -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe SqRef
_selectionSqref
        ]
    }

-- | See @CT_Pane@, p. 3913
instance ToElement Pane where
  toElement :: Name -> Pane -> Element
toElement Name
nm Pane{Maybe Double
Maybe CellRef
Maybe PaneState
Maybe PaneType
_paneYSplit :: Maybe Double
_paneXSplit :: Maybe Double
_paneTopLeftCell :: Maybe CellRef
_paneState :: Maybe PaneState
_paneActivePane :: Maybe PaneType
_paneYSplit :: Pane -> Maybe Double
_paneXSplit :: Pane -> Maybe Double
_paneTopLeftCell :: Pane -> Maybe CellRef
_paneState :: Pane -> Maybe PaneState
_paneActivePane :: Pane -> Maybe PaneType
..} = Element :: Name -> Map Name Text -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementNodes :: [Node]
elementNodes      = []
    , elementAttributes :: Map Name Text
elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, Text)] -> Map Name Text)
-> ([Maybe (Name, Text)] -> [(Name, Text)])
-> [Maybe (Name, Text)]
-> Map Name Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Name, Text)] -> Map Name Text)
-> [Maybe (Name, Text)] -> Map Name Text
forall a b. (a -> b) -> a -> b
$ [
          Name
"xSplit"      Name -> Maybe Double -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Double
_paneXSplit
        , Name
"ySplit"      Name -> Maybe Double -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Double
_paneYSplit
        , Name
"topLeftCell" Name -> Maybe CellRef -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe CellRef
_paneTopLeftCell
        , Name
"activePane"  Name -> Maybe PaneType -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe PaneType
_paneActivePane
        , Name
"state"       Name -> Maybe PaneState -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe PaneState
_paneState
        ]
    }

-- | See @ST_SheetViewType@, p. 3913
instance ToAttrVal SheetViewType where
  toAttrVal :: SheetViewType -> Text
toAttrVal SheetViewType
SheetViewTypeNormal           = Text
"normal"
  toAttrVal SheetViewType
SheetViewTypePageBreakPreview = Text
"pageBreakPreview"
  toAttrVal SheetViewType
SheetViewTypePageLayout       = Text
"pageLayout"

-- | See @ST_Pane@, p. 3914
instance ToAttrVal PaneType where
  toAttrVal :: PaneType -> Text
toAttrVal PaneType
PaneTypeBottomRight = Text
"bottomRight"
  toAttrVal PaneType
PaneTypeTopRight    = Text
"topRight"
  toAttrVal PaneType
PaneTypeBottomLeft  = Text
"bottomLeft"
  toAttrVal PaneType
PaneTypeTopLeft     = Text
"topLeft"

-- | See @ST_PaneState@, p. 3929
instance ToAttrVal PaneState where
  toAttrVal :: PaneState -> Text
toAttrVal PaneState
PaneStateSplit       = Text
"split"
  toAttrVal PaneState
PaneStateFrozen      = Text
"frozen"
  toAttrVal PaneState
PaneStateFrozenSplit = Text
"frozenSplit"

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}
-- | See @CT_SheetView@, p. 3913
instance FromCursor SheetView where
  fromCursor :: Cursor -> [SheetView]
fromCursor Cursor
cur = do
    Maybe Bool
_sheetViewWindowProtection         <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"windowProtection" Cursor
cur
    Maybe Bool
_sheetViewShowFormulas             <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"showFormulas" Cursor
cur
    Maybe Bool
_sheetViewShowGridLines            <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"showGridLines" Cursor
cur
    Maybe Bool
_sheetViewShowRowColHeaders        <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"showRowColHeaders"Cursor
cur
    Maybe Bool
_sheetViewShowZeros                <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"showZeros" Cursor
cur
    Maybe Bool
_sheetViewRightToLeft              <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"rightToLeft" Cursor
cur
    Maybe Bool
_sheetViewTabSelected              <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"tabSelected" Cursor
cur
    Maybe Bool
_sheetViewShowRuler                <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"showRuler" Cursor
cur
    Maybe Bool
_sheetViewShowOutlineSymbols       <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"showOutlineSymbols" Cursor
cur
    Maybe Bool
_sheetViewDefaultGridColor         <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"defaultGridColor" Cursor
cur
    Maybe Bool
_sheetViewShowWhiteSpace           <- Name -> Cursor -> [Maybe Bool]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"showWhiteSpace" Cursor
cur
    Maybe SheetViewType
_sheetViewType                     <- Name -> Cursor -> [Maybe SheetViewType]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"view" Cursor
cur
    Maybe CellRef
_sheetViewTopLeftCell              <- Name -> Cursor -> [Maybe CellRef]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"topLeftCell" Cursor
cur
    Maybe Int
_sheetViewColorId                  <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"colorId" Cursor
cur
    Maybe Int
_sheetViewZoomScale                <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"zoomScale" Cursor
cur
    Maybe Int
_sheetViewZoomScaleNormal          <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"zoomScaleNormal" Cursor
cur
    Maybe Int
_sheetViewZoomScaleSheetLayoutView <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"zoomScaleSheetLayoutView" Cursor
cur
    Maybe Int
_sheetViewZoomScalePageLayoutView  <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"zoomScalePageLayoutView" Cursor
cur
    Int
_sheetViewWorkbookViewId           <- Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"workbookViewId" Cursor
cur
    let _sheetViewPane :: Maybe Pane
_sheetViewPane = [Pane] -> Maybe Pane
forall a. [a] -> Maybe a
listToMaybe ([Pane] -> Maybe Pane) -> [Pane] -> Maybe Pane
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [Pane]) -> [Pane]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"pane") Axis -> (Cursor -> [Pane]) -> Cursor -> [Pane]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Pane]
forall a. FromCursor a => Cursor -> [a]
fromCursor
        _sheetViewSelection :: [Selection]
_sheetViewSelection = Cursor
cur Cursor -> (Cursor -> [Selection]) -> [Selection]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"selection") Axis -> (Cursor -> [Selection]) -> Cursor -> [Selection]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Selection]
forall a. FromCursor a => Cursor -> [a]
fromCursor
    SheetView -> [SheetView]
forall (m :: * -> *) a. Monad m => a -> m a
return SheetView :: Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe CellRef
-> Maybe SheetViewType
-> Maybe Bool
-> Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Pane
-> [Selection]
-> SheetView
SheetView{Int
[Selection]
Maybe Bool
Maybe Int
Maybe CellRef
Maybe SheetViewType
Maybe Pane
_sheetViewSelection :: [Selection]
_sheetViewPane :: Maybe Pane
_sheetViewWorkbookViewId :: Int
_sheetViewZoomScalePageLayoutView :: Maybe Int
_sheetViewZoomScaleSheetLayoutView :: Maybe Int
_sheetViewZoomScaleNormal :: Maybe Int
_sheetViewZoomScale :: Maybe Int
_sheetViewColorId :: Maybe Int
_sheetViewTopLeftCell :: Maybe CellRef
_sheetViewType :: Maybe SheetViewType
_sheetViewShowWhiteSpace :: Maybe Bool
_sheetViewDefaultGridColor :: Maybe Bool
_sheetViewShowOutlineSymbols :: Maybe Bool
_sheetViewShowRuler :: Maybe Bool
_sheetViewTabSelected :: Maybe Bool
_sheetViewRightToLeft :: Maybe Bool
_sheetViewShowZeros :: Maybe Bool
_sheetViewShowRowColHeaders :: Maybe Bool
_sheetViewShowGridLines :: Maybe Bool
_sheetViewShowFormulas :: Maybe Bool
_sheetViewWindowProtection :: Maybe Bool
_sheetViewSelection :: [Selection]
_sheetViewPane :: Maybe Pane
_sheetViewZoomScaleSheetLayoutView :: Maybe Int
_sheetViewZoomScalePageLayoutView :: Maybe Int
_sheetViewZoomScaleNormal :: Maybe Int
_sheetViewZoomScale :: Maybe Int
_sheetViewWorkbookViewId :: Int
_sheetViewWindowProtection :: Maybe Bool
_sheetViewType :: Maybe SheetViewType
_sheetViewTopLeftCell :: Maybe CellRef
_sheetViewTabSelected :: Maybe Bool
_sheetViewShowZeros :: Maybe Bool
_sheetViewShowWhiteSpace :: Maybe Bool
_sheetViewShowRuler :: Maybe Bool
_sheetViewShowRowColHeaders :: Maybe Bool
_sheetViewShowOutlineSymbols :: Maybe Bool
_sheetViewShowGridLines :: Maybe Bool
_sheetViewShowFormulas :: Maybe Bool
_sheetViewRightToLeft :: Maybe Bool
_sheetViewDefaultGridColor :: Maybe Bool
_sheetViewColorId :: Maybe Int
..}

instance FromXenoNode SheetView where
  fromXenoNode :: Node -> Either Text SheetView
fromXenoNode Node
root = Node -> AttrParser SheetView -> Either Text SheetView
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser SheetView -> Either Text SheetView)
-> AttrParser SheetView -> Either Text SheetView
forall a b. (a -> b) -> a -> b
$ do
    Maybe Bool
_sheetViewWindowProtection         <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"windowProtection"
    Maybe Bool
_sheetViewShowFormulas             <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"showFormulas"
    Maybe Bool
_sheetViewShowGridLines            <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"showGridLines"
    Maybe Bool
_sheetViewShowRowColHeaders        <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"showRowColHeaders"
    Maybe Bool
_sheetViewShowZeros                <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"showZeros"
    Maybe Bool
_sheetViewRightToLeft              <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"rightToLeft"
    Maybe Bool
_sheetViewTabSelected              <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"tabSelected"
    Maybe Bool
_sheetViewShowRuler                <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"showRuler"
    Maybe Bool
_sheetViewShowOutlineSymbols       <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"showOutlineSymbols"
    Maybe Bool
_sheetViewDefaultGridColor         <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"defaultGridColor"
    Maybe Bool
_sheetViewShowWhiteSpace           <- ByteString -> AttrParser (Maybe Bool)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"showWhiteSpace"
    Maybe SheetViewType
_sheetViewType                     <- ByteString -> AttrParser (Maybe SheetViewType)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"view"
    Maybe CellRef
_sheetViewTopLeftCell              <- ByteString -> AttrParser (Maybe CellRef)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"topLeftCell"
    Maybe Int
_sheetViewColorId                  <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"colorId"
    Maybe Int
_sheetViewZoomScale                <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"zoomScale"
    Maybe Int
_sheetViewZoomScaleNormal          <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"zoomScaleNormal"
    Maybe Int
_sheetViewZoomScaleSheetLayoutView <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"zoomScaleSheetLayoutView"
    Maybe Int
_sheetViewZoomScalePageLayoutView  <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"zoomScalePageLayoutView"
    Int
_sheetViewWorkbookViewId           <- ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"workbookViewId"
    (Maybe Pane
_sheetViewPane, [Selection]
_sheetViewSelection) <-
      Either Text (Maybe Pane, [Selection])
-> AttrParser (Maybe Pane, [Selection])
forall a. Either Text a -> AttrParser a
toAttrParser (Either Text (Maybe Pane, [Selection])
 -> AttrParser (Maybe Pane, [Selection]))
-> (ChildCollector (Maybe Pane, [Selection])
    -> Either Text (Maybe Pane, [Selection]))
-> ChildCollector (Maybe Pane, [Selection])
-> AttrParser (Maybe Pane, [Selection])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node
-> ChildCollector (Maybe Pane, [Selection])
-> Either Text (Maybe Pane, [Selection])
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector (Maybe Pane, [Selection])
 -> AttrParser (Maybe Pane, [Selection]))
-> ChildCollector (Maybe Pane, [Selection])
-> AttrParser (Maybe Pane, [Selection])
forall a b. (a -> b) -> a -> b
$
      (,) (Maybe Pane -> [Selection] -> (Maybe Pane, [Selection]))
-> ChildCollector (Maybe Pane)
-> ChildCollector ([Selection] -> (Maybe Pane, [Selection]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ChildCollector (Maybe Pane)
forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
maybeFromChild ByteString
"pane" ChildCollector ([Selection] -> (Maybe Pane, [Selection]))
-> ChildCollector [Selection]
-> ChildCollector (Maybe Pane, [Selection])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ChildCollector [Selection]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"selection"
    SheetView -> AttrParser SheetView
forall (m :: * -> *) a. Monad m => a -> m a
return SheetView :: Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe CellRef
-> Maybe SheetViewType
-> Maybe Bool
-> Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Pane
-> [Selection]
-> SheetView
SheetView {Int
[Selection]
Maybe Bool
Maybe Int
Maybe CellRef
Maybe SheetViewType
Maybe Pane
_sheetViewSelection :: [Selection]
_sheetViewPane :: Maybe Pane
_sheetViewWorkbookViewId :: Int
_sheetViewZoomScalePageLayoutView :: Maybe Int
_sheetViewZoomScaleSheetLayoutView :: Maybe Int
_sheetViewZoomScaleNormal :: Maybe Int
_sheetViewZoomScale :: Maybe Int
_sheetViewColorId :: Maybe Int
_sheetViewTopLeftCell :: Maybe CellRef
_sheetViewType :: Maybe SheetViewType
_sheetViewShowWhiteSpace :: Maybe Bool
_sheetViewDefaultGridColor :: Maybe Bool
_sheetViewShowOutlineSymbols :: Maybe Bool
_sheetViewShowRuler :: Maybe Bool
_sheetViewTabSelected :: Maybe Bool
_sheetViewRightToLeft :: Maybe Bool
_sheetViewShowZeros :: Maybe Bool
_sheetViewShowRowColHeaders :: Maybe Bool
_sheetViewShowGridLines :: Maybe Bool
_sheetViewShowFormulas :: Maybe Bool
_sheetViewWindowProtection :: Maybe Bool
_sheetViewSelection :: [Selection]
_sheetViewPane :: Maybe Pane
_sheetViewZoomScaleSheetLayoutView :: Maybe Int
_sheetViewZoomScalePageLayoutView :: Maybe Int
_sheetViewZoomScaleNormal :: Maybe Int
_sheetViewZoomScale :: Maybe Int
_sheetViewWorkbookViewId :: Int
_sheetViewWindowProtection :: Maybe Bool
_sheetViewType :: Maybe SheetViewType
_sheetViewTopLeftCell :: Maybe CellRef
_sheetViewTabSelected :: Maybe Bool
_sheetViewShowZeros :: Maybe Bool
_sheetViewShowWhiteSpace :: Maybe Bool
_sheetViewShowRuler :: Maybe Bool
_sheetViewShowRowColHeaders :: Maybe Bool
_sheetViewShowOutlineSymbols :: Maybe Bool
_sheetViewShowGridLines :: Maybe Bool
_sheetViewShowFormulas :: Maybe Bool
_sheetViewRightToLeft :: Maybe Bool
_sheetViewDefaultGridColor :: Maybe Bool
_sheetViewColorId :: Maybe Int
..}

-- | See @CT_Pane@, p. 3913
instance FromCursor Pane where
  fromCursor :: Cursor -> [Pane]
fromCursor Cursor
cur = do
    Maybe Double
_paneXSplit      <- Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"xSplit" Cursor
cur
    Maybe Double
_paneYSplit      <- Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"ySplit" Cursor
cur
    Maybe CellRef
_paneTopLeftCell <- Name -> Cursor -> [Maybe CellRef]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"topLeftCell" Cursor
cur
    Maybe PaneType
_paneActivePane  <- Name -> Cursor -> [Maybe PaneType]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"activePane" Cursor
cur
    Maybe PaneState
_paneState       <- Name -> Cursor -> [Maybe PaneState]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"state" Cursor
cur
    Pane -> [Pane]
forall (m :: * -> *) a. Monad m => a -> m a
return Pane :: Maybe PaneType
-> Maybe PaneState
-> Maybe CellRef
-> Maybe Double
-> Maybe Double
-> Pane
Pane{Maybe Double
Maybe CellRef
Maybe PaneState
Maybe PaneType
_paneState :: Maybe PaneState
_paneActivePane :: Maybe PaneType
_paneTopLeftCell :: Maybe CellRef
_paneYSplit :: Maybe Double
_paneXSplit :: Maybe Double
_paneYSplit :: Maybe Double
_paneXSplit :: Maybe Double
_paneTopLeftCell :: Maybe CellRef
_paneState :: Maybe PaneState
_paneActivePane :: Maybe PaneType
..}

instance FromXenoNode Pane where
  fromXenoNode :: Node -> Either Text Pane
fromXenoNode Node
root =
    Node -> AttrParser Pane -> Either Text Pane
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser Pane -> Either Text Pane)
-> AttrParser Pane -> Either Text Pane
forall a b. (a -> b) -> a -> b
$ do
      Maybe Double
_paneXSplit <- ByteString -> AttrParser (Maybe Double)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"xSplit"
      Maybe Double
_paneYSplit <- ByteString -> AttrParser (Maybe Double)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"ySplit"
      Maybe CellRef
_paneTopLeftCell <- ByteString -> AttrParser (Maybe CellRef)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"topLeftCell"
      Maybe PaneType
_paneActivePane <- ByteString -> AttrParser (Maybe PaneType)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"activePane"
      Maybe PaneState
_paneState <- ByteString -> AttrParser (Maybe PaneState)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"state"
      Pane -> AttrParser Pane
forall (m :: * -> *) a. Monad m => a -> m a
return Pane :: Maybe PaneType
-> Maybe PaneState
-> Maybe CellRef
-> Maybe Double
-> Maybe Double
-> Pane
Pane {Maybe Double
Maybe CellRef
Maybe PaneState
Maybe PaneType
_paneState :: Maybe PaneState
_paneActivePane :: Maybe PaneType
_paneTopLeftCell :: Maybe CellRef
_paneYSplit :: Maybe Double
_paneXSplit :: Maybe Double
_paneYSplit :: Maybe Double
_paneXSplit :: Maybe Double
_paneTopLeftCell :: Maybe CellRef
_paneState :: Maybe PaneState
_paneActivePane :: Maybe PaneType
..}

-- | See @CT_Selection@, p. 3914
instance FromCursor Selection where
  fromCursor :: Cursor -> [Selection]
fromCursor Cursor
cur = do
    Maybe PaneType
_selectionPane         <- Name -> Cursor -> [Maybe PaneType]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"pane" Cursor
cur
    Maybe CellRef
_selectionActiveCell   <- Name -> Cursor -> [Maybe CellRef]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"activeCell" Cursor
cur
    Maybe Int
_selectionActiveCellId <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"activeCellId" Cursor
cur
    Maybe SqRef
_selectionSqref        <- Name -> Cursor -> [Maybe SqRef]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"sqref" Cursor
cur
    Selection -> [Selection]
forall (m :: * -> *) a. Monad m => a -> m a
return Selection :: Maybe CellRef
-> Maybe Int -> Maybe PaneType -> Maybe SqRef -> Selection
Selection{Maybe Int
Maybe SqRef
Maybe CellRef
Maybe PaneType
_selectionSqref :: Maybe SqRef
_selectionActiveCellId :: Maybe Int
_selectionActiveCell :: Maybe CellRef
_selectionPane :: Maybe PaneType
_selectionSqref :: Maybe SqRef
_selectionPane :: Maybe PaneType
_selectionActiveCellId :: Maybe Int
_selectionActiveCell :: Maybe CellRef
..}

instance FromXenoNode Selection where
  fromXenoNode :: Node -> Either Text Selection
fromXenoNode Node
root =
    Node -> AttrParser Selection -> Either Text Selection
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
root (AttrParser Selection -> Either Text Selection)
-> AttrParser Selection -> Either Text Selection
forall a b. (a -> b) -> a -> b
$ do
      Maybe PaneType
_selectionPane <- ByteString -> AttrParser (Maybe PaneType)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"pane"
      Maybe CellRef
_selectionActiveCell <- ByteString -> AttrParser (Maybe CellRef)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"activeCell"
      Maybe Int
_selectionActiveCellId <- ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"activeCellId"
      Maybe SqRef
_selectionSqref <- ByteString -> AttrParser (Maybe SqRef)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"sqref"
      Selection -> AttrParser Selection
forall (m :: * -> *) a. Monad m => a -> m a
return Selection :: Maybe CellRef
-> Maybe Int -> Maybe PaneType -> Maybe SqRef -> Selection
Selection {Maybe Int
Maybe SqRef
Maybe CellRef
Maybe PaneType
_selectionSqref :: Maybe SqRef
_selectionActiveCellId :: Maybe Int
_selectionActiveCell :: Maybe CellRef
_selectionPane :: Maybe PaneType
_selectionSqref :: Maybe SqRef
_selectionPane :: Maybe PaneType
_selectionActiveCellId :: Maybe Int
_selectionActiveCell :: Maybe CellRef
..}

-- | See @ST_SheetViewType@, p. 3913
instance FromAttrVal SheetViewType where
  fromAttrVal :: Reader SheetViewType
fromAttrVal Text
"normal"           = SheetViewType -> Either String (SheetViewType, Text)
forall a. a -> Either String (a, Text)
readSuccess SheetViewType
SheetViewTypeNormal
  fromAttrVal Text
"pageBreakPreview" = SheetViewType -> Either String (SheetViewType, Text)
forall a. a -> Either String (a, Text)
readSuccess SheetViewType
SheetViewTypePageBreakPreview
  fromAttrVal Text
"pageLayout"       = SheetViewType -> Either String (SheetViewType, Text)
forall a. a -> Either String (a, Text)
readSuccess SheetViewType
SheetViewTypePageLayout
  fromAttrVal Text
t                  = Text -> Reader SheetViewType
forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"SheetViewType" Text
t

instance FromAttrBs SheetViewType where
  fromAttrBs :: ByteString -> Either Text SheetViewType
fromAttrBs ByteString
"normal"           = SheetViewType -> Either Text SheetViewType
forall (m :: * -> *) a. Monad m => a -> m a
return SheetViewType
SheetViewTypeNormal
  fromAttrBs ByteString
"pageBreakPreview" = SheetViewType -> Either Text SheetViewType
forall (m :: * -> *) a. Monad m => a -> m a
return SheetViewType
SheetViewTypePageBreakPreview
  fromAttrBs ByteString
"pageLayout"       = SheetViewType -> Either Text SheetViewType
forall (m :: * -> *) a. Monad m => a -> m a
return SheetViewType
SheetViewTypePageLayout
  fromAttrBs ByteString
x                  = Text -> ByteString -> Either Text SheetViewType
forall a. Text -> ByteString -> Either Text a
unexpectedAttrBs Text
"SheetViewType" ByteString
x

-- | See @ST_Pane@, p. 3914
instance FromAttrVal PaneType where
  fromAttrVal :: Reader PaneType
fromAttrVal Text
"bottomRight" = PaneType -> Either String (PaneType, Text)
forall a. a -> Either String (a, Text)
readSuccess PaneType
PaneTypeBottomRight
  fromAttrVal Text
"topRight"    = PaneType -> Either String (PaneType, Text)
forall a. a -> Either String (a, Text)
readSuccess PaneType
PaneTypeTopRight
  fromAttrVal Text
"bottomLeft"  = PaneType -> Either String (PaneType, Text)
forall a. a -> Either String (a, Text)
readSuccess PaneType
PaneTypeBottomLeft
  fromAttrVal Text
"topLeft"     = PaneType -> Either String (PaneType, Text)
forall a. a -> Either String (a, Text)
readSuccess PaneType
PaneTypeTopLeft
  fromAttrVal Text
t             = Text -> Reader PaneType
forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"PaneType" Text
t

instance FromAttrBs PaneType where
  fromAttrBs :: ByteString -> Either Text PaneType
fromAttrBs ByteString
"bottomRight" = PaneType -> Either Text PaneType
forall (m :: * -> *) a. Monad m => a -> m a
return PaneType
PaneTypeBottomRight
  fromAttrBs ByteString
"topRight"    = PaneType -> Either Text PaneType
forall (m :: * -> *) a. Monad m => a -> m a
return PaneType
PaneTypeTopRight
  fromAttrBs ByteString
"bottomLeft"  = PaneType -> Either Text PaneType
forall (m :: * -> *) a. Monad m => a -> m a
return PaneType
PaneTypeBottomLeft
  fromAttrBs ByteString
"topLeft"     = PaneType -> Either Text PaneType
forall (m :: * -> *) a. Monad m => a -> m a
return PaneType
PaneTypeTopLeft
  fromAttrBs ByteString
x             = Text -> ByteString -> Either Text PaneType
forall a. Text -> ByteString -> Either Text a
unexpectedAttrBs Text
"PaneType" ByteString
x

-- | See @ST_PaneState@, p. 3929
instance FromAttrVal PaneState where
  fromAttrVal :: Reader PaneState
fromAttrVal Text
"split"       = PaneState -> Either String (PaneState, Text)
forall a. a -> Either String (a, Text)
readSuccess PaneState
PaneStateSplit
  fromAttrVal Text
"frozen"      = PaneState -> Either String (PaneState, Text)
forall a. a -> Either String (a, Text)
readSuccess PaneState
PaneStateFrozen
  fromAttrVal Text
"frozenSplit" = PaneState -> Either String (PaneState, Text)
forall a. a -> Either String (a, Text)
readSuccess PaneState
PaneStateFrozenSplit
  fromAttrVal Text
t             = Text -> Reader PaneState
forall a. Text -> Text -> Either String (a, Text)
invalidText Text
"PaneState" Text
t

instance FromAttrBs PaneState where
  fromAttrBs :: ByteString -> Either Text PaneState
fromAttrBs ByteString
"split"       = PaneState -> Either Text PaneState
forall (m :: * -> *) a. Monad m => a -> m a
return PaneState
PaneStateSplit
  fromAttrBs ByteString
"frozen"      = PaneState -> Either Text PaneState
forall (m :: * -> *) a. Monad m => a -> m a
return PaneState
PaneStateFrozen
  fromAttrBs ByteString
"frozenSplit" = PaneState -> Either Text PaneState
forall (m :: * -> *) a. Monad m => a -> m a
return PaneState
PaneStateFrozenSplit
  fromAttrBs ByteString
x             = Text -> ByteString -> Either Text PaneState
forall a. Text -> ByteString -> Either Text a
unexpectedAttrBs Text
"PaneState" ByteString
x