{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Parser.Internal.PivotTable
  ( parsePivotTable
  , parseCache
  , fillCacheFieldsFromRecords
  ) where

import Control.Applicative
import Data.ByteString.Lazy (ByteString)
import Data.List (transpose)
import Data.Maybe (listToMaybe, mapMaybe, maybeToList)
import Data.Text (Text)
import Safe (atMay)
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Common
import Codec.Xlsx.Types.Internal
import Codec.Xlsx.Types.Internal.Relationships (odr)
import Codec.Xlsx.Types.PivotTable
import Codec.Xlsx.Types.PivotTable.Internal

parsePivotTable
  :: (CacheId -> Maybe (Text, Range, [CacheField]))
  -> ByteString
  -> Maybe PivotTable
parsePivotTable :: (CacheId -> Maybe (Text, Range, [CacheField]))
-> ByteString -> Maybe PivotTable
parsePivotTable CacheId -> Maybe (Text, Range, [CacheField])
srcByCacheId ByteString
bs =
  [PivotTable] -> Maybe PivotTable
forall a. [a] -> Maybe a
listToMaybe ([PivotTable] -> Maybe PivotTable)
-> (Document -> [PivotTable]) -> Document -> Maybe PivotTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [PivotTable]
parse (Cursor -> [PivotTable])
-> (Document -> Cursor) -> Document -> [PivotTable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Cursor
fromDocument (Document -> Maybe PivotTable) -> Document -> Maybe PivotTable
forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Document
parseLBS_ ParseSettings
forall a. Default a => a
def ByteString
bs
  where
    parse :: Cursor -> [PivotTable]
parse Cursor
cur = do
      CacheId
cacheId <- Name -> Cursor -> [CacheId]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"cacheId" Cursor
cur
      case CacheId -> Maybe (Text, Range, [CacheField])
srcByCacheId CacheId
cacheId of
        Maybe (Text, Range, [CacheField])
Nothing -> String -> [PivotTable]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no such cache"
        Just (Text
_pvtSrcSheet, Range
_pvtSrcRef, [CacheField]
cacheFields) -> do
          Text
_pvtDataCaption <- Name -> Cursor -> [Text]
attribute Name
"dataCaption" Cursor
cur
          Text
_pvtName <- Name -> Cursor -> [Text]
attribute Name
"name" Cursor
cur
          Range
_pvtLocation <- Cursor
cur Cursor -> (Cursor -> [Range]) -> [Range]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"location") Axis -> (Cursor -> [Range]) -> Cursor -> [Range]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Range]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"ref"
          Bool
_pvtRowGrandTotals <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"rowGrandTotals" Bool
True Cursor
cur
          Bool
_pvtColumnGrandTotals <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"colGrandTotals" Bool
True Cursor
cur
          Bool
_pvtOutline <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"outline" Bool
False Cursor
cur
          Bool
_pvtOutlineData <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"outlineData" Bool
False Cursor
cur
          let pvtFieldsWithHidden :: [(PivotFieldInfo, [Int])]
pvtFieldsWithHidden =
                Cursor
cur Cursor
-> (Cursor -> [(PivotFieldInfo, [Int])])
-> [(PivotFieldInfo, [Int])]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"pivotFields") Axis
-> (Cursor -> [(PivotFieldInfo, [Int])])
-> Cursor
-> [(PivotFieldInfo, [Int])]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"pivotField") Axis
-> (Cursor -> [(PivotFieldInfo, [Int])])
-> Cursor
-> [(PivotFieldInfo, [Int])]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
c -> do
                  -- actually gets overwritten from cache to have consistent field names
                  Maybe PivotFieldName
_pfiName <- Name -> Cursor -> [Maybe PivotFieldName]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"name" Cursor
c
                  FieldSortType
_pfiSortType <- Name -> FieldSortType -> Cursor -> [FieldSortType]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"sortType" FieldSortType
FieldSortManual Cursor
c
                  Bool
_pfiOutline <- Name -> Bool -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"outline" Bool
True Cursor
c
                  let hidden :: [Int]
hidden =
                        Cursor
c Cursor -> (Cursor -> [Int]) -> [Int]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"items") Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"item") Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                        Name -> Bool -> Axis
forall a. (Eq a, FromAttrVal a) => Name -> a -> Axis
attrValIs Name
"h" Bool
True Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"x"
                      _pfiHiddenItems :: [a]
_pfiHiddenItems = []
                  (PivotFieldInfo, [Int]) -> [(PivotFieldInfo, [Int])]
forall (m :: * -> *) a. Monad m => a -> m a
return (PivotFieldInfo :: Maybe PivotFieldName
-> Bool -> FieldSortType -> [CellValue] -> PivotFieldInfo
PivotFieldInfo {Bool
[CellValue]
Maybe PivotFieldName
FieldSortType
forall a. [a]
_pfiHiddenItems :: [CellValue]
_pfiSortType :: FieldSortType
_pfiOutline :: Bool
_pfiName :: Maybe PivotFieldName
_pfiHiddenItems :: forall a. [a]
_pfiOutline :: Bool
_pfiSortType :: FieldSortType
_pfiName :: Maybe PivotFieldName
..}, [Int]
hidden)
              _pvtFields :: [PivotFieldInfo]
_pvtFields = (((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
 -> [(Int, (PivotFieldInfo, [Int]))] -> [PivotFieldInfo])
-> [(Int, (PivotFieldInfo, [Int]))]
-> ((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
-> [PivotFieldInfo]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
-> [(Int, (PivotFieldInfo, [Int]))] -> [PivotFieldInfo]
forall a b. (a -> b) -> [a] -> [b]
map ([Int]
-> [(PivotFieldInfo, [Int])] -> [(Int, (PivotFieldInfo, [Int]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0.. ] [(PivotFieldInfo, [Int])]
pvtFieldsWithHidden) (((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
 -> [PivotFieldInfo])
-> ((Int, (PivotFieldInfo, [Int])) -> PivotFieldInfo)
-> [PivotFieldInfo]
forall a b. (a -> b) -> a -> b
$
                           \(Int
i, (PivotFieldInfo {Bool
[CellValue]
Maybe PivotFieldName
FieldSortType
_pfiHiddenItems :: [CellValue]
_pfiSortType :: FieldSortType
_pfiOutline :: Bool
_pfiName :: Maybe PivotFieldName
_pfiHiddenItems :: PivotFieldInfo -> [CellValue]
_pfiSortType :: PivotFieldInfo -> FieldSortType
_pfiOutline :: PivotFieldInfo -> Bool
_pfiName :: PivotFieldInfo -> Maybe PivotFieldName
..}, [Int]
hidden)) ->
                             let  _pfiHiddenItems :: [CellValue]
_pfiHiddenItems =
                                    [CellValue
item | (Int
n, CellValue
item) <- [Int] -> [CellValue] -> [(Int, CellValue)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0 :: Int) ..] [CellValue]
items, Int
n Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
hidden]
                                  (Maybe PivotFieldName
_pfiName, [CellValue]
items) = case [CacheField] -> Int -> Maybe CacheField
forall a. [a] -> Int -> Maybe a
atMay [CacheField]
cacheFields Int
i of
                                    Just CacheField{[CellValue]
PivotFieldName
cfItems :: CacheField -> [CellValue]
cfName :: CacheField -> PivotFieldName
cfItems :: [CellValue]
cfName :: PivotFieldName
..} -> (PivotFieldName -> Maybe PivotFieldName
forall a. a -> Maybe a
Just PivotFieldName
cfName, [CellValue]
cfItems)
                                    Maybe CacheField
Nothing -> (Maybe PivotFieldName
forall a. Maybe a
Nothing, [])
                             in PivotFieldInfo :: Maybe PivotFieldName
-> Bool -> FieldSortType -> [CellValue] -> PivotFieldInfo
PivotFieldInfo {Bool
[CellValue]
Maybe PivotFieldName
FieldSortType
_pfiName :: Maybe PivotFieldName
_pfiHiddenItems :: [CellValue]
_pfiSortType :: FieldSortType
_pfiOutline :: Bool
_pfiHiddenItems :: [CellValue]
_pfiSortType :: FieldSortType
_pfiOutline :: Bool
_pfiName :: Maybe PivotFieldName
..}
              nToFieldName :: [(Int, PivotFieldName)]
nToFieldName = [Int] -> [PivotFieldName] -> [(Int, PivotFieldName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([PivotFieldName] -> [(Int, PivotFieldName)])
-> [PivotFieldName] -> [(Int, PivotFieldName)]
forall a b. (a -> b) -> a -> b
$ (CacheField -> PivotFieldName) -> [CacheField] -> [PivotFieldName]
forall a b. (a -> b) -> [a] -> [b]
map CacheField -> PivotFieldName
cfName [CacheField]
cacheFields
              fieldNameList :: Int -> [PivotFieldName]
fieldNameList Int
fld = Maybe PivotFieldName -> [PivotFieldName]
forall a. Maybe a -> [a]
maybeToList (Maybe PivotFieldName -> [PivotFieldName])
-> Maybe PivotFieldName -> [PivotFieldName]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, PivotFieldName)] -> Maybe PivotFieldName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
fld [(Int, PivotFieldName)]
nToFieldName
              _pvtRowFields :: [PositionedField]
_pvtRowFields =
                Cursor
cur Cursor -> (Cursor -> [PositionedField]) -> [PositionedField]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"rowFields") Axis
-> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"field") Axis
-> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"x" (Cursor -> [Int])
-> (Int -> [PositionedField]) -> Cursor -> [PositionedField]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> [PositionedField]
fieldPosition
              _pvtColumnFields :: [PositionedField]
_pvtColumnFields =
                Cursor
cur Cursor -> (Cursor -> [PositionedField]) -> [PositionedField]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"colFields") Axis
-> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"field") Axis
-> (Cursor -> [PositionedField]) -> Cursor -> [PositionedField]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"x" (Cursor -> [Int])
-> (Int -> [PositionedField]) -> Cursor -> [PositionedField]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> [PositionedField]
fieldPosition
              _pvtDataFields :: [DataField]
_pvtDataFields =
                Cursor
cur Cursor -> (Cursor -> [DataField]) -> [DataField]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"dataFields") Axis -> (Cursor -> [DataField]) -> Cursor -> [DataField]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"dataField") Axis -> (Cursor -> [DataField]) -> Cursor -> [DataField]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
c -> do
                  Int
fld <- Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"fld" Cursor
c
                  PivotFieldName
_dfField <- Int -> [PivotFieldName]
fieldNameList Int
fld
                  -- TOFIX
                  Text
_dfName <- Name -> Text -> Cursor -> [Text]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"name" Text
"" Cursor
c
                  ConsolidateFunction
_dfFunction <- Name -> ConsolidateFunction -> Cursor -> [ConsolidateFunction]
forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"subtotal" ConsolidateFunction
ConsolidateSum Cursor
c
                  DataField -> [DataField]
forall (m :: * -> *) a. Monad m => a -> m a
return DataField :: PivotFieldName -> Text -> ConsolidateFunction -> DataField
DataField {Text
ConsolidateFunction
PivotFieldName
_dfFunction :: ConsolidateFunction
_dfName :: Text
_dfField :: PivotFieldName
_dfFunction :: ConsolidateFunction
_dfName :: Text
_dfField :: PivotFieldName
..}
              fieldPosition :: Int -> [PositionedField]
              fieldPosition :: Int -> [PositionedField]
fieldPosition (-2) = PositionedField -> [PositionedField]
forall (m :: * -> *) a. Monad m => a -> m a
return PositionedField
DataPosition
              fieldPosition Int
n =
                PivotFieldName -> PositionedField
FieldPosition (PivotFieldName -> PositionedField)
-> [PivotFieldName] -> [PositionedField]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [PivotFieldName]
fieldNameList Int
n
          PivotTable -> [PivotTable]
forall (m :: * -> *) a. Monad m => a -> m a
return PivotTable :: Text
-> Text
-> [PositionedField]
-> [PositionedField]
-> [DataField]
-> [PivotFieldInfo]
-> Bool
-> Bool
-> Bool
-> Bool
-> Range
-> Text
-> Range
-> PivotTable
PivotTable {Bool
[DataField]
[PositionedField]
[PivotFieldInfo]
Text
Range
_pvtSrcRef :: Range
_pvtSrcSheet :: Text
_pvtLocation :: Range
_pvtOutlineData :: Bool
_pvtOutline :: Bool
_pvtColumnGrandTotals :: Bool
_pvtRowGrandTotals :: Bool
_pvtFields :: [PivotFieldInfo]
_pvtDataFields :: [DataField]
_pvtColumnFields :: [PositionedField]
_pvtRowFields :: [PositionedField]
_pvtDataCaption :: Text
_pvtName :: Text
_pvtDataFields :: [DataField]
_pvtColumnFields :: [PositionedField]
_pvtRowFields :: [PositionedField]
_pvtFields :: [PivotFieldInfo]
_pvtOutlineData :: Bool
_pvtOutline :: Bool
_pvtColumnGrandTotals :: Bool
_pvtRowGrandTotals :: Bool
_pvtLocation :: Range
_pvtName :: Text
_pvtDataCaption :: Text
_pvtSrcRef :: Range
_pvtSrcSheet :: Text
..}

parseCache :: ByteString -> Maybe (Text, CellRef, [CacheField], Maybe RefId)
parseCache :: ByteString -> Maybe (Text, Range, [CacheField], Maybe RefId)
parseCache ByteString
bs = [(Text, Range, [CacheField], Maybe RefId)]
-> Maybe (Text, Range, [CacheField], Maybe RefId)
forall a. [a] -> Maybe a
listToMaybe ([(Text, Range, [CacheField], Maybe RefId)]
 -> Maybe (Text, Range, [CacheField], Maybe RefId))
-> (Document -> [(Text, Range, [CacheField], Maybe RefId)])
-> Document
-> Maybe (Text, Range, [CacheField], Maybe RefId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [(Text, Range, [CacheField], Maybe RefId)]
forall a b a.
(FromAttrVal a, FromAttrVal b, FromCursor a) =>
Cursor -> [(Text, b, [a], Maybe a)]
parse (Cursor -> [(Text, Range, [CacheField], Maybe RefId)])
-> (Document -> Cursor)
-> Document
-> [(Text, Range, [CacheField], Maybe RefId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Cursor
fromDocument (Document -> Maybe (Text, Range, [CacheField], Maybe RefId))
-> Document -> Maybe (Text, Range, [CacheField], Maybe RefId)
forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Document
parseLBS_ ParseSettings
forall a. Default a => a
def ByteString
bs
  where
    parse :: Cursor -> [(Text, b, [a], Maybe a)]
parse Cursor
cur = do
      Maybe a
refId <- Name -> Cursor -> [Maybe a]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute (Text -> Name
odr Text
"id") Cursor
cur
      (Text
sheet, b
ref) <-
        Cursor
cur Cursor -> (Cursor -> [(Text, b)]) -> [(Text, b)]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"cacheSource") Axis -> (Cursor -> [(Text, b)]) -> Cursor -> [(Text, b)]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"worksheetSource") Axis -> (Cursor -> [(Text, b)]) -> Cursor -> [(Text, b)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        (Text -> b -> (Text, b)) -> [Text] -> [b] -> [(Text, b)]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ([Text] -> [b] -> [(Text, b)])
-> (Cursor -> [Text]) -> Cursor -> [b] -> [(Text, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Cursor -> [Text]
attribute Name
"sheet" (Cursor -> [b] -> [(Text, b)])
-> (Cursor -> [b]) -> Cursor -> [(Text, b)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Cursor -> [b]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"ref"
      let fields :: [a]
fields =
            Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"cacheFields") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"cacheField") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
            Cursor -> [a]
forall a. FromCursor a => Cursor -> [a]
fromCursor
      (Text, b, [a], Maybe a) -> [(Text, b, [a], Maybe a)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
sheet, b
ref, [a]
fields, Maybe a
refId)

fillCacheFieldsFromRecords :: [CacheField] -> [CacheRecord] -> [CacheField]
fillCacheFieldsFromRecords :: [CacheField] -> [CacheRecord] -> [CacheField]
fillCacheFieldsFromRecords [CacheField]
fields [CacheRecord]
recs =
  (CacheField -> CacheRecord -> CacheField)
-> [CacheField] -> [CacheRecord] -> [CacheField]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CacheField -> CacheRecord -> CacheField
addValues [CacheField]
fields ([CacheRecord] -> [CacheRecord]
forall a. [[a]] -> [[a]]
transpose [CacheRecord]
recs)
  where
    addValues :: CacheField -> CacheRecord -> CacheField
addValues CacheField
field CacheRecord
recVals =
      if [CellValue] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CacheField -> [CellValue]
cfItems CacheField
field)
        then CacheField
field {cfItems :: [CellValue]
cfItems = (CacheRecordValue -> Maybe CellValue) -> CacheRecord -> [CellValue]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CacheRecordValue -> Maybe CellValue
recToCellValue CacheRecord
recVals}
        else CacheField
field
    recToCellValue :: CacheRecordValue -> Maybe CellValue
recToCellValue (CacheText Text
t) = CellValue -> Maybe CellValue
forall a. a -> Maybe a
Just (CellValue -> Maybe CellValue) -> CellValue -> Maybe CellValue
forall a b. (a -> b) -> a -> b
$ Text -> CellValue
CellText Text
t
    recToCellValue (CacheNumber Double
n) = CellValue -> Maybe CellValue
forall a. a -> Maybe a
Just (CellValue -> Maybe CellValue) -> CellValue -> Maybe CellValue
forall a b. (a -> b) -> a -> b
$ Double -> CellValue
CellDouble Double
n
    recToCellValue (CacheIndex Int
_) = Maybe CellValue
forall a. Maybe a
Nothing