Types.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Codec.Xlsx.Types (
    -- * The main types
    Xlsx(..)
    , Styles(..)
    , DefinedNames(..)
    , ColumnsWidth(..)
    , PageSetup(..)
    , Worksheet(..)
    , CellMap
    , CellValue(..)
    , CellFormula(..)
    , Cell(..)
    , RowProperties (..)
    -- * Lenses
    -- ** Workbook
    , xlSheets
    , xlStyles
    , xlDefinedNames
    , xlCustomProperties
    -- ** Worksheet
    , wsColumns
    , wsRowPropertiesMap
    , wsCells
    , wsDrawing
    , wsMerges
    , wsSheetViews
    , wsPageSetup
    , wsConditionalFormattings
    , wsDataValidations
    , wsPivotTables
    , wsAutoFilter
    , wsTables
    -- ** Cells
    , cellValue
    , cellStyle
    , cellComment
    , cellFormula
    -- * Style helpers
    , emptyStyles
    , renderStyleSheet
    , parseStyleSheet
    -- * Misc
    , simpleCellFormula
    , def
    , toRows
    , fromRows
    , module X
    ) where

import           Control.Exception                      (SomeException,
                                                         toException)
import           Control.Lens.TH
import qualified Data.ByteString.Lazy                   as L
import           Data.Default
import           Data.Function                          (on)
import           Data.List                              (groupBy)
import           Data.Map                               (Map)
import qualified Data.Map                               as M
import           Data.Maybe                             (catMaybes)
import           Data.Text                              (Text)
import           Text.XML                               (Element (..), parseLBS,
                                                         renderLBS)
import           Text.XML.Cursor

import           Codec.Xlsx.Parser.Internal
import           Codec.Xlsx.Types.AutoFilter            as X
import           Codec.Xlsx.Types.Comment               as X
import           Codec.Xlsx.Types.Common                as X
import           Codec.Xlsx.Types.ConditionalFormatting as X
import           Codec.Xlsx.Types.DataValidation        as X
import           Codec.Xlsx.Types.Drawing               as X
import           Codec.Xlsx.Types.Drawing.Chart         as X
import           Codec.Xlsx.Types.Drawing.Common        as X
import           Codec.Xlsx.Types.PageSetup             as X
import           Codec.Xlsx.Types.PivotTable            as X
import           Codec.Xlsx.Types.RichText              as X
import           Codec.Xlsx.Types.SheetViews            as X
import           Codec.Xlsx.Types.StyleSheet            as X
import           Codec.Xlsx.Types.Table                 as X
import           Codec.Xlsx.Types.Variant               as X
import           Codec.Xlsx.Writer.Internal

-- | Formula for the cell.
--
-- TODO: array. dataTable and shared formula types support
--
-- See 18.3.1.40 "f (Formula)" (p. 1636)
data CellFormula
    = NormalCellFormula
      { _cellfExpression    :: Formula
      , _cellfAssignsToName :: Bool
      -- ^ Specifies that this formula assigns a value to a name.
      , _cellfCalculate     :: Bool
      -- ^ Indicates that this formula needs to be recalculated
      -- the next time calculation is performed.
      -- [/Example/: This is always set on volatile functions,
      -- like =RAND(), and circular references. /end example/]
      } deriving (Eq, Show)

simpleCellFormula :: Text -> CellFormula
simpleCellFormula expr = NormalCellFormula
    { _cellfExpression    = Formula expr
    , _cellfAssignsToName = False
    , _cellfCalculate     = False
    }

-- | Currently cell details include only cell values and style ids
-- (e.g. formulas from @\<f\>@ and inline strings from @\<is\>@
-- subelements are ignored)
data Cell = Cell
    { _cellStyle   :: Maybe Int
    , _cellValue   :: Maybe CellValue
    , _cellComment :: Maybe Comment
    , _cellFormula :: Maybe CellFormula
    } deriving (Eq, Show)

makeLenses ''Cell

instance Default Cell where
    def = Cell Nothing Nothing Nothing Nothing

-- | Map containing cell values which are indexed by row and column
-- if you need to use more traditional (x,y) indexing please you could
-- use corresponding accessors from ''Codec.Xlsx.Lens''
type CellMap = Map (Int, Int) Cell

data RowProperties = RowProps { rowHeight :: Maybe Double, rowStyle::Maybe Int}
                   deriving (Read,Eq,Show,Ord)

-- | Column range (from cwMin to cwMax) width
data ColumnsWidth = ColumnsWidth
  { cwMin :: Int
  -- ^ First column affected by this 'ColumnWidth' record.
  , cwMax :: Int
  -- ^ Last column affected by this 'ColumnWidth' record.
  , cwWidth :: Double
  -- ^ Column width measured as the number of characters of the
  -- maximum digit width of the numbers 0, 1, 2, ..., 9 as rendered in
  -- the normal style's font.
  --
  -- See longer description in Section 18.3.1.13 "col (Column Width &
  -- Formatting)" (p. 1605)
  , cwStyle :: Maybe Int
  -- ^ Default style for the affected column(s). Affects cells not yet
  -- allocated in the column(s).  In other words, this style applies
  -- to new columns.
  } deriving (Eq, Show)

instance FromCursor ColumnsWidth where
  fromCursor c = do
    cwMin <- fromAttribute "min" c
    cwMax <- fromAttribute "max" c
    cwWidth <- fromAttribute "width" c
    cwStyle <- maybeAttribute "style" c
    return ColumnsWidth {..}

-- | Xlsx worksheet
data Worksheet = Worksheet
  { _wsColumns :: [ColumnsWidth] -- ^ column widths
  , _wsRowPropertiesMap :: Map Int RowProperties -- ^ custom row properties (height, style) map
  , _wsCells :: CellMap -- ^ data mapped by (row, column) pairs
  , _wsDrawing :: Maybe Drawing -- ^ SpreadsheetML Drawing
  , _wsMerges :: [Range] -- ^ list of cell merges
  , _wsSheetViews :: Maybe [SheetView]
  , _wsPageSetup :: Maybe PageSetup
  , _wsConditionalFormattings :: Map SqRef ConditionalFormatting
  , _wsDataValidations :: Map SqRef DataValidation
  , _wsPivotTables :: [PivotTable]
  , _wsAutoFilter :: Maybe AutoFilter
  , _wsTables :: [Table]
  } deriving (Eq, Show)

makeLenses ''Worksheet

instance Default Worksheet where
    def = Worksheet [] M.empty M.empty Nothing [] Nothing Nothing M.empty M.empty [] Nothing []

newtype Styles = Styles {unStyles :: L.ByteString}
            deriving (Eq, Show)

-- | Structured representation of Xlsx file (currently a subset of its contents)
data Xlsx = Xlsx
    { _xlSheets           :: [(Text, Worksheet)]
    , _xlStyles           :: Styles
    , _xlDefinedNames     :: DefinedNames
    , _xlCustomProperties :: Map Text Variant
    } deriving (Eq, Show)

-- | Defined names
--
-- Each defined name consists of a name, an optional local sheet ID, and a value.
--
-- This element defines the collection of defined names for this workbook.
-- Defined names are descriptive names to represent cells, ranges of cells,
-- formulas, or constant values. Defined names can be used to represent a range
-- on any worksheet.
--
-- Excel also defines a number of reserved names with a special interpretation:
--
-- * @_xlnm.Print_Area@ specifies the workbook's print area.
--   Example value: @SheetName!$A:$A,SheetName!$1:$4@
-- * @_xlnm.Print_Titles@ specifies the row(s) or column(s) to repeat
--   at the top of each printed page.
-- * @_xlnm.Sheet_Title@:refers to a sheet title.
--
-- and others. See Section 18.2.6, "definedNames (Defined Names)" (p. 1728) of
-- the spec (second edition).
--
-- NOTE: Right now this is only a minimal implementation of defined names.
newtype DefinedNames = DefinedNames [(Text, Maybe Text, Text)]
  deriving (Eq, Show)

makeLenses ''Xlsx

instance Default Xlsx where
    def = Xlsx [] emptyStyles def M.empty

instance Default DefinedNames where
    def = DefinedNames []

emptyStyles :: Styles
emptyStyles = Styles "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\
\<styleSheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\"></styleSheet>"

-- | Render 'StyleSheet'
--
-- This is used to render a structured 'StyleSheet' into a raw XML 'Styles'
-- document. Actually /replacing/ 'Styles' with 'StyleSheet' would mean we
-- would need to write a /parser/ for 'StyleSheet' as well (and would moreover
-- require that we support the full style sheet specification, which is still
-- quite a bit of work).
renderStyleSheet :: StyleSheet -> Styles
renderStyleSheet = Styles . renderLBS def . toDocument

-- | Parse 'StyleSheet'
--
-- This is used to parse raw 'Styles' into structured 'StyleSheet'
-- currently not all of the style sheet specification is supported
-- so parser (and the data model) is to be completed
parseStyleSheet :: Styles -> Either SomeException StyleSheet
parseStyleSheet (Styles bs) = parseLBS def bs >>= parseDoc
  where
    parseDoc doc = case fromCursor (fromDocument doc) of
      [stylesheet] -> Right stylesheet
      _ -> Left . toException $ ParseException "Could not parse style sheets"

-- | converts cells mapped by (row, column) into rows which contain
-- row index and cells as pairs of column indices and cell values
toRows :: CellMap -> [(Int, [(Int, Cell)])]
toRows cells =
    map extractRow $ groupBy ((==) `on` (fst . fst)) $ M.toList cells
  where
    extractRow row@(((x,_),_):_) =
        (x, map (\((_,y),v) -> (y,v)) row)
    extractRow _ = error "invalid CellMap row"

-- | reverse to 'toRows'
fromRows :: [(Int, [(Int, Cell)])] -> CellMap
fromRows rows = M.fromList $ concatMap mapRow rows
  where
    mapRow (r, cells) = map (\(c, v) -> ((r, c), v)) cells

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

instance FromCursor CellFormula where
    fromCursor cur = do
        t <- fromAttributeDef "t" "normal" cur
        typedCellFormula t cur

typedCellFormula :: Text -> Cursor -> [CellFormula]
typedCellFormula "normal" cur = do
    _cellfExpression <- fromCursor cur
    _cellfAssignsToName <- fromAttributeDef "bx" False cur
    _cellfCalculate <- fromAttributeDef "ca" False cur
    return NormalCellFormula{..}
typedCellFormula _ _ = fail "parseable cell formula type was not found"

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

instance ToElement CellFormula where
    toElement nm NormalCellFormula{..} =
        let formulaEl = toElement nm _cellfExpression
        in formulaEl
           { elementAttributes =
                   M.fromList $ catMaybes [ "bx" .=? justTrue _cellfAssignsToName
                                          , "ca" .=? justTrue _cellfCalculate ]
           }