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

#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens (makeLenses)
#endif
import Control.DeepSeq (NFData)
import Data.Maybe (catMaybes, maybeToList)
import Data.Text (Text)
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Cursor

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

-- | Tables are ranges of data in the worksheet that have special
-- behavior applied which allow users to better sort, analyze, format,
-- manage, add, and delete data. Tables and table columns can also be
-- referenced through formulas by the spreadsheet application using
-- friendly names, making formula calculations that use tables much
-- easier to understand and maintain. Tables provide a natural way for
-- working with large sets of tabular data.
--
-- NOTE: as @headerRowCount@ property isn't yet supported it's
-- supposed that it's library user liability to guarantee that the 1st
-- row of 'tblRef' range contains cells with names specified in
-- `tblColumns`
--
-- Section 18.5 \"Tables\" (p. 1728)
-- Section 18.5.1 \"Tables\" (p. 1729)
-- Section 18.5.1.2 "table (Table)" (p. 1730)
data Table = Table
  { Table -> Text
tblDisplayName :: Text
    -- ^ A string representing the name of the table. This is the name
    -- that shall be used in formula references, and displayed in the UI
    -- to the spreadsheet user.  This name shall not have any spaces in
    -- it, and it shall be unique amongst all other displayNames and
    -- definedNames in the workbook. The character lengths and
    -- restrictions are the same as for definedNames .
  , Table -> Maybe Text
tblName :: Maybe Text
    -- ^ A string representing the name of the table that is used to
    -- reference the table programmatically through the spreadsheet
    -- applications object model. This string shall be unique per table
    -- per sheet. It has the same length and character restrictions as
    -- for displayName.  By default this should be the same as the
    -- table's 'tblDisplayName' . This name should also be kept in synch with
    -- the displayName when the displayName is updated in the UI by the
    -- spreadsheet user.
  , Table -> CellRef
tblRef :: CellRef
    -- ^ The range on the relevant sheet that the table occupies
    -- expressed using A1 style referencing.
  , Table -> [TableColumn]
tblColumns :: [TableColumn]
    -- ^ columns of this table, specification requires any table to
    -- include at least 1 column
  , Table -> Maybe AutoFilter
tblAutoFilter :: Maybe AutoFilter
  } deriving (Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq, Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show, (forall x. Table -> Rep Table x)
-> (forall x. Rep Table x -> Table) -> Generic Table
forall x. Rep Table x -> Table
forall x. Table -> Rep Table x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Table x -> Table
$cfrom :: forall x. Table -> Rep Table x
Generic)
instance NFData Table

-- | Single table column
--
-- TODO: styling information
--
-- Section 18.5.1.3 "tableColumn (Table Column)" (p. 1735)
data TableColumn = TableColumn
  { TableColumn -> Text
tblcName :: Text
  -- ^ A string representing the unique caption of the table
  -- column. This is what shall be displayed in the header row in the
  -- UI, and is referenced through functions. This name shall be
  -- unique per table.
  } deriving (TableColumn -> TableColumn -> Bool
(TableColumn -> TableColumn -> Bool)
-> (TableColumn -> TableColumn -> Bool) -> Eq TableColumn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableColumn -> TableColumn -> Bool
$c/= :: TableColumn -> TableColumn -> Bool
== :: TableColumn -> TableColumn -> Bool
$c== :: TableColumn -> TableColumn -> Bool
Eq, Int -> TableColumn -> ShowS
[TableColumn] -> ShowS
TableColumn -> String
(Int -> TableColumn -> ShowS)
-> (TableColumn -> String)
-> ([TableColumn] -> ShowS)
-> Show TableColumn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableColumn] -> ShowS
$cshowList :: [TableColumn] -> ShowS
show :: TableColumn -> String
$cshow :: TableColumn -> String
showsPrec :: Int -> TableColumn -> ShowS
$cshowsPrec :: Int -> TableColumn -> ShowS
Show, (forall x. TableColumn -> Rep TableColumn x)
-> (forall x. Rep TableColumn x -> TableColumn)
-> Generic TableColumn
forall x. Rep TableColumn x -> TableColumn
forall x. TableColumn -> Rep TableColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableColumn x -> TableColumn
$cfrom :: forall x. TableColumn -> Rep TableColumn x
Generic)
instance NFData TableColumn

makeLenses ''Table

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

instance FromCursor Table where
  fromCursor :: Cursor -> [Table]
fromCursor Cursor
c = do
    Text
tblDisplayName <- Name -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"displayName" Cursor
c
    Maybe Text
tblName <- Name -> Cursor -> [Maybe Text]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"name" Cursor
c
    CellRef
tblRef <- Name -> Cursor -> [CellRef]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"ref" Cursor
c
    Maybe AutoFilter
tblAutoFilter <- Name -> Cursor -> [Maybe AutoFilter]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
n_ Text
"autoFilter") Cursor
c
    let tblColumns :: [TableColumn]
tblColumns =
          Cursor
c Cursor -> (Cursor -> [TableColumn]) -> [TableColumn]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"tableColumns") Axis -> (Cursor -> [TableColumn]) -> Cursor -> [TableColumn]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"tableColumn") Axis -> (Cursor -> [TableColumn]) -> Cursor -> [TableColumn]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
          (Text -> TableColumn) -> [Text] -> [TableColumn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TableColumn
TableColumn ([Text] -> [TableColumn])
-> (Cursor -> [Text]) -> Cursor -> [TableColumn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"name"
    Table -> [Table]
forall (m :: * -> *) a. Monad m => a -> m a
return Table :: Text
-> Maybe Text
-> CellRef
-> [TableColumn]
-> Maybe AutoFilter
-> Table
Table {[TableColumn]
Maybe Text
Maybe AutoFilter
Text
CellRef
tblColumns :: [TableColumn]
tblAutoFilter :: Maybe AutoFilter
tblRef :: CellRef
tblName :: Maybe Text
tblDisplayName :: Text
tblAutoFilter :: Maybe AutoFilter
tblColumns :: [TableColumn]
tblRef :: CellRef
tblName :: Maybe Text
tblDisplayName :: Text
..}

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

tableToDocument :: Table -> Int -> Document
tableToDocument :: Table -> Int -> Document
tableToDocument Table
tbl Int
i =
  Text -> Element -> Document
documentFromElement Text
"Table generated by xlsx" (Element -> Document) -> Element -> Document
forall a b. (a -> b) -> a -> b
$
  Name -> Table -> Int -> Element
tableToElement Name
"table" Table
tbl Int
i

tableToElement :: Name -> Table -> Int -> Element
tableToElement :: Name -> Table -> Int -> Element
tableToElement Name
nm Table {[TableColumn]
Maybe Text
Maybe AutoFilter
Text
CellRef
tblAutoFilter :: Maybe AutoFilter
tblColumns :: [TableColumn]
tblRef :: CellRef
tblName :: Maybe Text
tblDisplayName :: Text
tblAutoFilter :: Table -> Maybe AutoFilter
tblColumns :: Table -> [TableColumn]
tblRef :: Table -> CellRef
tblName :: Table -> Maybe Text
tblDisplayName :: Table -> Text
..} Int
i = Name -> [(Name, Text)] -> [Element] -> Element
elementList Name
nm [(Name, Text)]
attrs [Element]
subElements
  where
    attrs :: [(Name, Text)]
attrs =
      [ Name
"id" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
i
      , Name
"displayName" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
tblDisplayName
      , Name
"ref" Name -> CellRef -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= CellRef
tblRef
      ] [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. [a] -> [a] -> [a]
++
      [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes
      [ Name
"name" Name -> Maybe Text -> Maybe (Name, Text)
forall a. ToAttrVal a => Name -> Maybe a -> Maybe (Name, Text)
.=? Maybe Text
tblName
      ]
    subElements :: [Element]
subElements =
      Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList (Name -> AutoFilter -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"autoFilter" (AutoFilter -> Element) -> Maybe AutoFilter -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AutoFilter
tblAutoFilter) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
      Maybe Element -> [Element]
forall a. Maybe a -> [a]
maybeToList (Name -> [Element] -> Maybe Element
nonEmptyCountedElementList
                    Name
"tableColumns"
                    [ Name -> [(Name, Text)] -> Element
leafElement Name
"tableColumn" [Name
"id" Name -> Int -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Int
i', Name
"name" Name -> Text -> (Name, Text)
forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= TableColumn -> Text
tblcName TableColumn
c]
                    | (Int
i', TableColumn
c) <- [Int] -> [TableColumn] -> [(Int, TableColumn)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [TableColumn]
tblColumns
                    ]
                  )