{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TupleSections             #-}

-- | This module provides a function for reading .xlsx files
module Codec.Xlsx.Parser
  ( toXlsx
  , toXlsxEither
  , toXlsxFast
  , toXlsxEitherFast
  , ParseError(..)
  , Parser
  ) where

import qualified Codec.Archive.Zip as Zip
import Control.Applicative
import Control.Arrow (left)
import Control.Error.Safe (headErr)
import Control.Error.Util (note)
import Control.Exception (Exception)
#ifdef USE_MICROLENS
import Lens.Micro
#else
import Control.Lens hiding ((<.>), element, views)
#endif
import Control.Monad (forM, join, void)
import Control.Monad.Except (catchError, throwError)
import Data.Bool (bool)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy as LB
import Data.ByteString.Lazy.Char8 ()
import Data.List
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Data.Traversable
import GHC.Generics (Generic)
import Prelude hiding (sequence)
import Safe
import System.FilePath.Posix
import Text.XML as X
import Text.XML.Cursor hiding (bool)
import qualified Xeno.DOM as Xeno

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Parser.Internal.PivotTable
import Codec.Xlsx.Types
import Codec.Xlsx.Types.Cell (formulaDataFromCursor)
import Codec.Xlsx.Types.Common (xlsxTextToCellValue)
import Codec.Xlsx.Types.Internal
import Codec.Xlsx.Types.Internal.CfPair
import Codec.Xlsx.Types.Internal.CommentTable as CommentTable
import Codec.Xlsx.Types.Internal.ContentTypes as ContentTypes
import Codec.Xlsx.Types.Internal.CustomProperties
       as CustomProperties
import Codec.Xlsx.Types.Internal.DvPair
import Codec.Xlsx.Types.Internal.FormulaData
import Codec.Xlsx.Types.Internal.Relationships as Relationships
import Codec.Xlsx.Types.Internal.SharedStringTable
import Codec.Xlsx.Types.PivotTable.Internal

-- | Reads `Xlsx' from raw data (lazy bytestring)
toXlsx :: L.ByteString -> Xlsx
toXlsx :: ByteString -> Xlsx
toXlsx = (ParseError -> Xlsx)
-> (Xlsx -> Xlsx) -> Either ParseError Xlsx -> Xlsx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Xlsx
forall a. HasCallStack => [Char] -> a
error ([Char] -> Xlsx) -> (ParseError -> [Char]) -> ParseError -> Xlsx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) Xlsx -> Xlsx
forall a. a -> a
id (Either ParseError Xlsx -> Xlsx)
-> (ByteString -> Either ParseError Xlsx) -> ByteString -> Xlsx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseError Xlsx
toXlsxEither

data ParseError = InvalidZipArchive
                | MissingFile FilePath
                | InvalidFile FilePath Text
                | InvalidRef FilePath RefId
                | InconsistentXlsx Text
                deriving (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> [Char]
(Int -> ParseError -> ShowS)
-> (ParseError -> [Char])
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> [Char]
$cshow :: ParseError -> [Char]
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show, (forall x. ParseError -> Rep ParseError x)
-> (forall x. Rep ParseError x -> ParseError) -> Generic ParseError
forall x. Rep ParseError x -> ParseError
forall x. ParseError -> Rep ParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseError x -> ParseError
$cfrom :: forall x. ParseError -> Rep ParseError x
Generic)

instance Exception ParseError

type Parser = Either ParseError

-- | Reads `Xlsx' from raw data (lazy bytestring) using @xeno@ library
-- using some "cheating":
--
-- * not doing 100% xml validation
-- * replacing only <https://www.w3.org/TR/REC-xml/#sec-predefined-ent predefined entities>
--   and <https://www.w3.org/TR/REC-xml/#NT-CharRef Unicode character references>
--   (without checking codepoint validity)
-- * almost not using XML namespaces
toXlsxFast :: L.ByteString -> Xlsx
toXlsxFast :: ByteString -> Xlsx
toXlsxFast = (ParseError -> Xlsx)
-> (Xlsx -> Xlsx) -> Either ParseError Xlsx -> Xlsx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Xlsx
forall a. HasCallStack => [Char] -> a
error ([Char] -> Xlsx) -> (ParseError -> [Char]) -> ParseError -> Xlsx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) Xlsx -> Xlsx
forall a. a -> a
id (Either ParseError Xlsx -> Xlsx)
-> (ByteString -> Either ParseError Xlsx) -> ByteString -> Xlsx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseError Xlsx
toXlsxEitherFast

-- | Reads `Xlsx' from raw data (lazy bytestring), failing with 'Left' on parse error
toXlsxEither :: L.ByteString -> Parser Xlsx
toXlsxEither :: ByteString -> Either ParseError Xlsx
toXlsxEither = (Archive
 -> SharedStringTable
 -> ContentTypes
 -> Caches
 -> WorksheetFile
 -> Parser Worksheet)
-> ByteString -> Either ParseError Xlsx
toXlsxEitherBase Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
extractSheet

-- | Fast parsing with 'Left' on parse error, see 'toXlsxFast'
toXlsxEitherFast :: L.ByteString -> Parser Xlsx
toXlsxEitherFast :: ByteString -> Either ParseError Xlsx
toXlsxEitherFast = (Archive
 -> SharedStringTable
 -> ContentTypes
 -> Caches
 -> WorksheetFile
 -> Parser Worksheet)
-> ByteString -> Either ParseError Xlsx
toXlsxEitherBase Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
extractSheetFast

toXlsxEitherBase ::
     (Zip.Archive -> SharedStringTable -> ContentTypes -> Caches -> WorksheetFile -> Parser Worksheet)
  -> L.ByteString
  -> Parser Xlsx
toXlsxEitherBase :: (Archive
 -> SharedStringTable
 -> ContentTypes
 -> Caches
 -> WorksheetFile
 -> Parser Worksheet)
-> ByteString -> Either ParseError Xlsx
toXlsxEitherBase Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
parseSheet ByteString
bs = do
  Archive
ar <- ([Char] -> ParseError)
-> Either [Char] Archive -> Either ParseError Archive
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (ParseError -> [Char] -> ParseError
forall a b. a -> b -> a
const ParseError
InvalidZipArchive) (Either [Char] Archive -> Either ParseError Archive)
-> Either [Char] Archive -> Either ParseError Archive
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] Archive
Zip.toArchiveOrFail ByteString
bs
  SharedStringTable
sst <- Archive -> Parser SharedStringTable
getSharedStrings Archive
ar
  ContentTypes
contentTypes <- Archive -> Parser ContentTypes
getContentTypes Archive
ar
  ([WorksheetFile]
wfs, DefinedNames
names, Caches
cacheSources, DateBase
dateBase) <- Archive -> Parser ([WorksheetFile], DefinedNames, Caches, DateBase)
readWorkbook Archive
ar
  [(Text, Worksheet)]
sheets <- [WorksheetFile]
-> (WorksheetFile -> Either ParseError (Text, Worksheet))
-> Either ParseError [(Text, Worksheet)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [WorksheetFile]
wfs ((WorksheetFile -> Either ParseError (Text, Worksheet))
 -> Either ParseError [(Text, Worksheet)])
-> (WorksheetFile -> Either ParseError (Text, Worksheet))
-> Either ParseError [(Text, Worksheet)]
forall a b. (a -> b) -> a -> b
$ \WorksheetFile
wf -> do
      Worksheet
sheet <- Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
parseSheet Archive
ar SharedStringTable
sst ContentTypes
contentTypes Caches
cacheSources WorksheetFile
wf
      (Text, Worksheet) -> Either ParseError (Text, Worksheet)
forall (m :: * -> *) a. Monad m => a -> m a
return (WorksheetFile -> Text
wfName WorksheetFile
wf, Worksheet
sheet)
  CustomProperties Map Text Variant
customPropMap <- Archive -> Parser CustomProperties
getCustomProperties Archive
ar
  Xlsx -> Either ParseError Xlsx
forall (m :: * -> *) a. Monad m => a -> m a
return (Xlsx -> Either ParseError Xlsx) -> Xlsx -> Either ParseError Xlsx
forall a b. (a -> b) -> a -> b
$ [(Text, Worksheet)]
-> Styles -> DefinedNames -> Map Text Variant -> DateBase -> Xlsx
Xlsx [(Text, Worksheet)]
sheets (Archive -> Styles
getStyles Archive
ar) DefinedNames
names Map Text Variant
customPropMap DateBase
dateBase

data WorksheetFile = WorksheetFile { WorksheetFile -> Text
wfName :: Text
                                   , WorksheetFile -> [Char]
wfPath :: FilePath
                                   }
                   deriving (Int -> WorksheetFile -> ShowS
[WorksheetFile] -> ShowS
WorksheetFile -> [Char]
(Int -> WorksheetFile -> ShowS)
-> (WorksheetFile -> [Char])
-> ([WorksheetFile] -> ShowS)
-> Show WorksheetFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WorksheetFile] -> ShowS
$cshowList :: [WorksheetFile] -> ShowS
show :: WorksheetFile -> [Char]
$cshow :: WorksheetFile -> [Char]
showsPrec :: Int -> WorksheetFile -> ShowS
$cshowsPrec :: Int -> WorksheetFile -> ShowS
Show, (forall x. WorksheetFile -> Rep WorksheetFile x)
-> (forall x. Rep WorksheetFile x -> WorksheetFile)
-> Generic WorksheetFile
forall x. Rep WorksheetFile x -> WorksheetFile
forall x. WorksheetFile -> Rep WorksheetFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WorksheetFile x -> WorksheetFile
$cfrom :: forall x. WorksheetFile -> Rep WorksheetFile x
Generic)

type Caches = [(CacheId, (Text, CellRef, [CacheField]))]

extractSheetFast :: Zip.Archive
                 -> SharedStringTable
                 -> ContentTypes
                 -> Caches
                 -> WorksheetFile
                 -> Parser Worksheet
extractSheetFast :: Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
extractSheetFast Archive
ar SharedStringTable
sst ContentTypes
contentTypes Caches
caches WorksheetFile
wf = do
  ByteString
file <-
    ParseError -> Maybe ByteString -> Either ParseError ByteString
forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
filePath) (Maybe ByteString -> Either ParseError ByteString)
-> Maybe ByteString -> Either ParseError ByteString
forall a b. (a -> b) -> a -> b
$
    Entry -> ByteString
Zip.fromEntry (Entry -> ByteString) -> Maybe Entry -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
filePath Archive
ar
  Relationships
sheetRels <- Archive -> [Char] -> Parser Relationships
getRels Archive
ar [Char]
filePath
  Node
root <-
    (XenoException -> ParseError)
-> Either XenoException Node -> Either ParseError Node
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (\XenoException
ex -> [Char] -> Text -> ParseError
InvalidFile [Char]
filePath (Text -> ParseError) -> Text -> ParseError
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (XenoException -> [Char]
forall a. Show a => a -> [Char]
show XenoException
ex)) (Either XenoException Node -> Either ParseError Node)
-> Either XenoException Node -> Either ParseError Node
forall a b. (a -> b) -> a -> b
$
    ByteString -> Either XenoException Node
Xeno.parse (ByteString -> ByteString
LB.toStrict ByteString
file)
  Node -> Relationships -> Parser Worksheet
parseWorksheet Node
root Relationships
sheetRels
  where
    filePath :: [Char]
filePath = WorksheetFile -> [Char]
wfPath WorksheetFile
wf
    parseWorksheet :: Xeno.Node -> Relationships -> Parser Worksheet
    parseWorksheet :: Node -> Relationships -> Parser Worksheet
parseWorksheet Node
root Relationships
sheetRels = do
      let prefixes :: NsPrefixes
prefixes = Node -> NsPrefixes
nsPrefixes Node
root
          odrNs :: p
odrNs =
            p
"http://schemas.openxmlformats.org/officeDocument/2006/relationships"
          odrX :: ByteString -> ByteString
odrX = NsPrefixes -> ByteString -> ByteString -> ByteString
addPrefix NsPrefixes
prefixes ByteString
forall p. IsString p => p
odrNs
          skip :: ByteString -> ChildCollector ()
skip = ChildCollector (Maybe Node) -> ChildCollector ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ChildCollector (Maybe Node) -> ChildCollector ())
-> (ByteString -> ChildCollector (Maybe Node))
-> ByteString
-> ChildCollector ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChildCollector (Maybe Node)
maybeChild
      (Worksheet
ws, [RefId]
tableIds, Maybe RefId
drawingRId, Maybe RefId
legacyDrRId) <-
        Either Text (Worksheet, [RefId], Maybe RefId, Maybe RefId)
-> Parser (Worksheet, [RefId], Maybe RefId, Maybe RefId)
forall a. Either Text a -> Parser a
liftEither (Either Text (Worksheet, [RefId], Maybe RefId, Maybe RefId)
 -> Parser (Worksheet, [RefId], Maybe RefId, Maybe RefId))
-> (ChildCollector (Worksheet, [RefId], Maybe RefId, Maybe RefId)
    -> Either Text (Worksheet, [RefId], Maybe RefId, Maybe RefId))
-> ChildCollector (Worksheet, [RefId], Maybe RefId, Maybe RefId)
-> Parser (Worksheet, [RefId], Maybe RefId, Maybe RefId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node
-> ChildCollector (Worksheet, [RefId], Maybe RefId, Maybe RefId)
-> Either Text (Worksheet, [RefId], Maybe RefId, Maybe RefId)
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector (Worksheet, [RefId], Maybe RefId, Maybe RefId)
 -> Parser (Worksheet, [RefId], Maybe RefId, Maybe RefId))
-> ChildCollector (Worksheet, [RefId], Maybe RefId, Maybe RefId)
-> Parser (Worksheet, [RefId], Maybe RefId, Maybe RefId)
forall a b. (a -> b) -> a -> b
$ do
          ByteString -> ChildCollector ()
skip ByteString
"sheetPr"
          ByteString -> ChildCollector ()
skip ByteString
"dimension"
          Maybe [SheetView]
_wsSheetViews <- (Maybe [SheetView] -> Maybe [SheetView])
-> ChildCollector (Maybe [SheetView])
-> ChildCollector (Maybe [SheetView])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe [SheetView] -> Maybe [SheetView]
forall a. Maybe [a] -> Maybe [a]
justNonEmpty (ChildCollector (Maybe [SheetView])
 -> ChildCollector (Maybe [SheetView]))
-> ((Node -> Either Text [SheetView])
    -> ChildCollector (Maybe [SheetView]))
-> (Node -> Either Text [SheetView])
-> ChildCollector (Maybe [SheetView])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (Node -> Either Text [SheetView])
-> ChildCollector (Maybe [SheetView])
forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"sheetViews" ((Node -> Either Text [SheetView])
 -> ChildCollector (Maybe [SheetView]))
-> (Node -> Either Text [SheetView])
-> ChildCollector (Maybe [SheetView])
forall a b. (a -> b) -> a -> b
$ \Node
n ->
            Node -> ChildCollector [SheetView] -> Either Text [SheetView]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (ChildCollector [SheetView] -> Either Text [SheetView])
-> ChildCollector [SheetView] -> Either Text [SheetView]
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [SheetView]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"sheetView"
          ByteString -> ChildCollector ()
skip ByteString
"sheetFormatPr"
          [ColumnsProperties]
_wsColumnsProperties <-
            (Maybe [ColumnsProperties] -> [ColumnsProperties])
-> ChildCollector (Maybe [ColumnsProperties])
-> ChildCollector [ColumnsProperties]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ColumnsProperties]
-> Maybe [ColumnsProperties] -> [ColumnsProperties]
forall a. a -> Maybe a -> a
fromMaybe []) (ChildCollector (Maybe [ColumnsProperties])
 -> ChildCollector [ColumnsProperties])
-> ((Node -> Either Text [ColumnsProperties])
    -> ChildCollector (Maybe [ColumnsProperties]))
-> (Node -> Either Text [ColumnsProperties])
-> ChildCollector [ColumnsProperties]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (Node -> Either Text [ColumnsProperties])
-> ChildCollector (Maybe [ColumnsProperties])
forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"cols" ((Node -> Either Text [ColumnsProperties])
 -> ChildCollector [ColumnsProperties])
-> (Node -> Either Text [ColumnsProperties])
-> ChildCollector [ColumnsProperties]
forall a b. (a -> b) -> a -> b
$ \Node
n ->
              Node
-> ChildCollector [ColumnsProperties]
-> Either Text [ColumnsProperties]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (ByteString -> ChildCollector [ColumnsProperties]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"col")
          (Map Int RowProperties
_wsRowPropertiesMap, CellMap
_wsCells, Map SharedFormulaIndex SharedFormulaOptions
_wsSharedFormulas) <-
            ByteString
-> (Node
    -> Either
         Text
         (Map Int RowProperties, CellMap,
          Map SharedFormulaIndex SharedFormulaOptions))
-> ChildCollector
     (Map Int RowProperties, CellMap,
      Map SharedFormulaIndex SharedFormulaOptions)
forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"sheetData" ((Node
  -> Either
       Text
       (Map Int RowProperties, CellMap,
        Map SharedFormulaIndex SharedFormulaOptions))
 -> ChildCollector
      (Map Int RowProperties, CellMap,
       Map SharedFormulaIndex SharedFormulaOptions))
-> (Node
    -> Either
         Text
         (Map Int RowProperties, CellMap,
          Map SharedFormulaIndex SharedFormulaOptions))
-> ChildCollector
     (Map Int RowProperties, CellMap,
      Map SharedFormulaIndex SharedFormulaOptions)
forall a b. (a -> b) -> a -> b
$ \Node
n -> do
              [Node]
rows <- Node -> ChildCollector [Node] -> Either Text [Node]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (ChildCollector [Node] -> Either Text [Node])
-> ChildCollector [Node] -> Either Text [Node]
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"row"
              [(Int, Maybe RowProperties,
  [(Int, Int, Cell,
    Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
forall (t :: * -> *).
Foldable t =>
t (Int, Maybe RowProperties,
   [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRows ([(Int, Maybe RowProperties,
   [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
 -> (Map Int RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions))
-> Either
     Text
     [(Int, Maybe RowProperties,
       [(Int, Int, Cell,
         Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
-> Either
     Text
     (Map Int RowProperties, CellMap,
      Map SharedFormulaIndex SharedFormulaOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
-> (Node
    -> Either
         Text
         (Int, Maybe RowProperties,
          [(Int, Int, Cell,
            Maybe (SharedFormulaIndex, SharedFormulaOptions))]))
-> Either
     Text
     [(Int, Maybe RowProperties,
       [(Int, Int, Cell,
         Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
rows Node
-> Either
     Text
     (Int, Maybe RowProperties,
      [(Int, Int, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
parseRow
          ByteString -> ChildCollector ()
skip ByteString
"sheetCalcPr"
          Maybe SheetProtection
_wsProtection <- ByteString -> ChildCollector (Maybe SheetProtection)
forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
maybeFromChild ByteString
"sheetProtection"
          ByteString -> ChildCollector ()
skip ByteString
"protectedRanges"
          ByteString -> ChildCollector ()
skip ByteString
"scenarios"
          Maybe AutoFilter
_wsAutoFilter <- ByteString -> ChildCollector (Maybe AutoFilter)
forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
maybeFromChild ByteString
"autoFilter"
          ByteString -> ChildCollector ()
skip ByteString
"sortState"
          ByteString -> ChildCollector ()
skip ByteString
"dataConsolidate"
          ByteString -> ChildCollector ()
skip ByteString
"customSheetViews"
          [Range]
_wsMerges <- (Maybe [Range] -> [Range])
-> ChildCollector (Maybe [Range]) -> ChildCollector [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Range] -> Maybe [Range] -> [Range]
forall a. a -> Maybe a -> a
fromMaybe []) (ChildCollector (Maybe [Range]) -> ChildCollector [Range])
-> ((Node -> Either Text [Range])
    -> ChildCollector (Maybe [Range]))
-> (Node -> Either Text [Range])
-> ChildCollector [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (Node -> Either Text [Range]) -> ChildCollector (Maybe [Range])
forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"mergeCells" ((Node -> Either Text [Range]) -> ChildCollector [Range])
-> (Node -> Either Text [Range]) -> ChildCollector [Range]
forall a b. (a -> b) -> a -> b
$ \Node
n -> do
            [Node]
mCells <- Node -> ChildCollector [Node] -> Either Text [Node]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (ChildCollector [Node] -> Either Text [Node])
-> ChildCollector [Node] -> Either Text [Node]
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"mergeCell"
            [Node] -> (Node -> Either Text Range) -> Either Text [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
mCells ((Node -> Either Text Range) -> Either Text [Range])
-> (Node -> Either Text Range) -> Either Text [Range]
forall a b. (a -> b) -> a -> b
$ \Node
mCell -> Node -> AttrParser Range -> Either Text Range
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
mCell (AttrParser Range -> Either Text Range)
-> AttrParser Range -> Either Text Range
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrParser Range
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"ref"
          Map SqRef ConditionalFormatting
_wsConditionalFormattings <-
            [(SqRef, ConditionalFormatting)] -> Map SqRef ConditionalFormatting
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SqRef, ConditionalFormatting)]
 -> Map SqRef ConditionalFormatting)
-> ([CfPair] -> [(SqRef, ConditionalFormatting)])
-> [CfPair]
-> Map SqRef ConditionalFormatting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CfPair -> (SqRef, ConditionalFormatting))
-> [CfPair] -> [(SqRef, ConditionalFormatting)]
forall a b. (a -> b) -> [a] -> [b]
map CfPair -> (SqRef, ConditionalFormatting)
unCfPair ([CfPair] -> Map SqRef ConditionalFormatting)
-> ChildCollector [CfPair]
-> ChildCollector (Map SqRef ConditionalFormatting)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ChildCollector [CfPair]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"conditionalFormatting"
          Map SqRef DataValidation
_wsDataValidations <-
            (Maybe (Map SqRef DataValidation) -> Map SqRef DataValidation)
-> ChildCollector (Maybe (Map SqRef DataValidation))
-> ChildCollector (Map SqRef DataValidation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map SqRef DataValidation
-> Maybe (Map SqRef DataValidation) -> Map SqRef DataValidation
forall a. a -> Maybe a -> a
fromMaybe Map SqRef DataValidation
forall a. Monoid a => a
mempty) (ChildCollector (Maybe (Map SqRef DataValidation))
 -> ChildCollector (Map SqRef DataValidation))
-> ((Node -> Either Text (Map SqRef DataValidation))
    -> ChildCollector (Maybe (Map SqRef DataValidation)))
-> (Node -> Either Text (Map SqRef DataValidation))
-> ChildCollector (Map SqRef DataValidation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (Node -> Either Text (Map SqRef DataValidation))
-> ChildCollector (Maybe (Map SqRef DataValidation))
forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"dataValidations" ((Node -> Either Text (Map SqRef DataValidation))
 -> ChildCollector (Map SqRef DataValidation))
-> (Node -> Either Text (Map SqRef DataValidation))
-> ChildCollector (Map SqRef DataValidation)
forall a b. (a -> b) -> a -> b
$ \Node
n -> do
              [(SqRef, DataValidation)] -> Map SqRef DataValidation
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SqRef, DataValidation)] -> Map SqRef DataValidation)
-> ([DvPair] -> [(SqRef, DataValidation)])
-> [DvPair]
-> Map SqRef DataValidation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DvPair -> (SqRef, DataValidation))
-> [DvPair] -> [(SqRef, DataValidation)]
forall a b. (a -> b) -> [a] -> [b]
map DvPair -> (SqRef, DataValidation)
unDvPair ([DvPair] -> Map SqRef DataValidation)
-> Either Text [DvPair] -> Either Text (Map SqRef DataValidation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                Node -> ChildCollector [DvPair] -> Either Text [DvPair]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (ByteString -> ChildCollector [DvPair]
forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"dataValidation")
          ByteString -> ChildCollector ()
skip ByteString
"hyperlinks"
          ByteString -> ChildCollector ()
skip ByteString
"printOptions"
          ByteString -> ChildCollector ()
skip ByteString
"pageMargins"
          Maybe PageSetup
_wsPageSetup <- ByteString -> ChildCollector (Maybe PageSetup)
forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
maybeFromChild ByteString
"pageSetup"
          ByteString -> ChildCollector ()
skip ByteString
"headerFooter"
          ByteString -> ChildCollector ()
skip ByteString
"rowBreaks"
          ByteString -> ChildCollector ()
skip ByteString
"colBreaks"
          ByteString -> ChildCollector ()
skip ByteString
"customProperties"
          ByteString -> ChildCollector ()
skip ByteString
"cellWatches"
          ByteString -> ChildCollector ()
skip ByteString
"ignoredErrors"
          ByteString -> ChildCollector ()
skip ByteString
"smartTags"
          Maybe RefId
drawingRId <- ByteString
-> (Node -> Either Text RefId) -> ChildCollector (Maybe RefId)
forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"drawing" ((Node -> Either Text RefId) -> ChildCollector (Maybe RefId))
-> (Node -> Either Text RefId) -> ChildCollector (Maybe RefId)
forall a b. (a -> b) -> a -> b
$ \Node
n ->
            Node -> AttrParser RefId -> Either Text RefId
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
n (AttrParser RefId -> Either Text RefId)
-> AttrParser RefId -> Either Text RefId
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrParser RefId
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr (ByteString -> ByteString
odrX ByteString
"id")
          Maybe RefId
legacyDrRId <- ByteString
-> (Node -> Either Text RefId) -> ChildCollector (Maybe RefId)
forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"legacyDrawing" ((Node -> Either Text RefId) -> ChildCollector (Maybe RefId))
-> (Node -> Either Text RefId) -> ChildCollector (Maybe RefId)
forall a b. (a -> b) -> a -> b
$ \Node
n ->
            Node -> AttrParser RefId -> Either Text RefId
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
n (AttrParser RefId -> Either Text RefId)
-> AttrParser RefId -> Either Text RefId
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrParser RefId
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr (ByteString -> ByteString
odrX ByteString
"id")
          [RefId]
tableIds <- (Maybe [RefId] -> [RefId])
-> ChildCollector (Maybe [RefId]) -> ChildCollector [RefId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([RefId] -> Maybe [RefId] -> [RefId]
forall a. a -> Maybe a -> a
fromMaybe []) (ChildCollector (Maybe [RefId]) -> ChildCollector [RefId])
-> ((Node -> Either Text [RefId])
    -> ChildCollector (Maybe [RefId]))
-> (Node -> Either Text [RefId])
-> ChildCollector [RefId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> (Node -> Either Text [RefId]) -> ChildCollector (Maybe [RefId])
forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"tableParts" ((Node -> Either Text [RefId]) -> ChildCollector [RefId])
-> (Node -> Either Text [RefId]) -> ChildCollector [RefId]
forall a b. (a -> b) -> a -> b
$ \Node
n -> do
            [Node]
tParts <- Node -> ChildCollector [Node] -> Either Text [Node]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (ChildCollector [Node] -> Either Text [Node])
-> ChildCollector [Node] -> Either Text [Node]
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"tablePart"
            [Node] -> (Node -> Either Text RefId) -> Either Text [RefId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
tParts ((Node -> Either Text RefId) -> Either Text [RefId])
-> (Node -> Either Text RefId) -> Either Text [RefId]
forall a b. (a -> b) -> a -> b
$ \Node
part ->
              Node -> AttrParser RefId -> Either Text RefId
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
part (AttrParser RefId -> Either Text RefId)
-> AttrParser RefId -> Either Text RefId
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrParser RefId
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr (ByteString -> ByteString
odrX ByteString
"id")

          -- all explicitly assigned fields filled below
          (Worksheet, [RefId], Maybe RefId, Maybe RefId)
-> ChildCollector (Worksheet, [RefId], Maybe RefId, Maybe RefId)
forall (m :: * -> *) a. Monad m => a -> m a
return (
            Worksheet :: [ColumnsProperties]
-> Map Int RowProperties
-> CellMap
-> Maybe Drawing
-> [Range]
-> Maybe [SheetView]
-> Maybe PageSetup
-> Map SqRef ConditionalFormatting
-> Map SqRef DataValidation
-> [PivotTable]
-> Maybe AutoFilter
-> [Table]
-> Maybe SheetProtection
-> Map SharedFormulaIndex SharedFormulaOptions
-> Worksheet
Worksheet
            { _wsDrawing :: Maybe Drawing
_wsDrawing = Maybe Drawing
forall a. Maybe a
Nothing
            , _wsPivotTables :: [PivotTable]
_wsPivotTables = []
            , _wsTables :: [Table]
_wsTables = []
            , [Range]
[ColumnsProperties]
Maybe [SheetView]
Maybe SheetProtection
Maybe PageSetup
Maybe AutoFilter
Map Int RowProperties
CellMap
Map SqRef ConditionalFormatting
Map SqRef DataValidation
Map SharedFormulaIndex SharedFormulaOptions
_wsSharedFormulas :: Map SharedFormulaIndex SharedFormulaOptions
_wsProtection :: Maybe SheetProtection
_wsAutoFilter :: Maybe AutoFilter
_wsDataValidations :: Map SqRef DataValidation
_wsConditionalFormattings :: Map SqRef ConditionalFormatting
_wsPageSetup :: Maybe PageSetup
_wsSheetViews :: Maybe [SheetView]
_wsMerges :: [Range]
_wsCells :: CellMap
_wsRowPropertiesMap :: Map Int RowProperties
_wsColumnsProperties :: [ColumnsProperties]
_wsPageSetup :: Maybe PageSetup
_wsDataValidations :: Map SqRef DataValidation
_wsConditionalFormattings :: Map SqRef ConditionalFormatting
_wsMerges :: [Range]
_wsAutoFilter :: Maybe AutoFilter
_wsProtection :: Maybe SheetProtection
_wsSharedFormulas :: Map SharedFormulaIndex SharedFormulaOptions
_wsCells :: CellMap
_wsRowPropertiesMap :: Map Int RowProperties
_wsColumnsProperties :: [ColumnsProperties]
_wsSheetViews :: Maybe [SheetView]
..
            }
            , [RefId]
tableIds
            , Maybe RefId
drawingRId
            , Maybe RefId
legacyDrRId)

      let commentsType :: p
commentsType = p
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments"
          commentTarget :: Maybe FilePath
          commentTarget :: Maybe [Char]
commentTarget = Relationship -> [Char]
relTarget (Relationship -> [Char]) -> Maybe Relationship -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Relationships -> Maybe Relationship
findRelByType Text
forall p. IsString p => p
commentsType Relationships
sheetRels
          legacyDrPath :: Maybe [Char]
legacyDrPath = (Relationship -> [Char]) -> Maybe Relationship -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Relationship -> [Char]
relTarget (Maybe Relationship -> Maybe [Char])
-> (RefId -> Maybe Relationship) -> RefId -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RefId -> Relationships -> Maybe Relationship)
-> Relationships -> RefId -> Maybe Relationship
forall a b c. (a -> b -> c) -> b -> a -> c
flip RefId -> Relationships -> Maybe Relationship
Relationships.lookup Relationships
sheetRels (RefId -> Maybe [Char]) -> Maybe RefId -> Maybe [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RefId
legacyDrRId
      Maybe CommentTable
commentsMap <-
        (Maybe (Maybe CommentTable) -> Maybe CommentTable)
-> Either ParseError (Maybe (Maybe CommentTable))
-> Either ParseError (Maybe CommentTable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe CommentTable) -> Maybe CommentTable
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either ParseError (Maybe (Maybe CommentTable))
 -> Either ParseError (Maybe CommentTable))
-> (([Char] -> Either ParseError (Maybe CommentTable))
    -> Either ParseError (Maybe (Maybe CommentTable)))
-> ([Char] -> Either ParseError (Maybe CommentTable))
-> Either ParseError (Maybe CommentTable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char]
-> ([Char] -> Either ParseError (Maybe CommentTable))
-> Either ParseError (Maybe (Maybe CommentTable))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe [Char]
commentTarget (([Char] -> Either ParseError (Maybe CommentTable))
 -> Either ParseError (Maybe CommentTable))
-> ([Char] -> Either ParseError (Maybe CommentTable))
-> Either ParseError (Maybe CommentTable)
forall a b. (a -> b) -> a -> b
$ Archive
-> Maybe [Char] -> [Char] -> Either ParseError (Maybe CommentTable)
getComments Archive
ar Maybe [Char]
legacyDrPath
      let commentCells :: CellMap
commentCells =
            [((Int, Int), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [ (Range -> (Int, Int)
fromSingleCellRefNoting Range
r, Cell
forall a. Default a => a
def { _cellComment :: Maybe Comment
_cellComment = Comment -> Maybe Comment
forall a. a -> Maybe a
Just Comment
cmnt})
            | (Range
r, Comment
cmnt) <- [(Range, Comment)]
-> (CommentTable -> [(Range, Comment)])
-> Maybe CommentTable
-> [(Range, Comment)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CommentTable -> [(Range, Comment)]
CommentTable.toList Maybe CommentTable
commentsMap
            ]
          assignComment :: Cell -> Cell -> Cell
assignComment Cell
withCmnt Cell
noCmnt =
            Cell
noCmnt Cell -> (Cell -> Cell) -> Cell
forall a b. a -> (a -> b) -> b
& (Maybe Comment -> Identity (Maybe Comment))
-> Cell -> Identity Cell
Lens' Cell (Maybe Comment)
cellComment ((Maybe Comment -> Identity (Maybe Comment))
 -> Cell -> Identity Cell)
-> Maybe Comment -> Cell -> Cell
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Cell
withCmnt Cell
-> Getting (Maybe Comment) Cell (Maybe Comment) -> Maybe Comment
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Comment) Cell (Maybe Comment)
Lens' Cell (Maybe Comment)
cellComment)
          mergeComments :: CellMap -> CellMap
mergeComments = (Cell -> Cell -> Cell) -> CellMap -> CellMap -> CellMap
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Cell -> Cell -> Cell
assignComment CellMap
commentCells
      [Table]
tables <- [RefId]
-> (RefId -> Either ParseError Table) -> Either ParseError [Table]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RefId]
tableIds ((RefId -> Either ParseError Table) -> Either ParseError [Table])
-> (RefId -> Either ParseError Table) -> Either ParseError [Table]
forall a b. (a -> b) -> a -> b
$ \RefId
rId -> do
        [Char]
fp <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
filePath Relationships
sheetRels RefId
rId
        Archive -> [Char] -> Either ParseError Table
getTable Archive
ar [Char]
fp
      Maybe Drawing
drawing <- Maybe RefId
-> (RefId -> Either ParseError Drawing)
-> Either ParseError (Maybe Drawing)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe RefId
drawingRId ((RefId -> Either ParseError Drawing)
 -> Either ParseError (Maybe Drawing))
-> (RefId -> Either ParseError Drawing)
-> Either ParseError (Maybe Drawing)
forall a b. (a -> b) -> a -> b
$ \RefId
dId -> do
        Relationship
rel <- ParseError -> Maybe Relationship -> Either ParseError Relationship
forall a b. a -> Maybe b -> Either a b
note ([Char] -> RefId -> ParseError
InvalidRef [Char]
filePath RefId
dId) (Maybe Relationship -> Either ParseError Relationship)
-> Maybe Relationship -> Either ParseError Relationship
forall a b. (a -> b) -> a -> b
$ RefId -> Relationships -> Maybe Relationship
Relationships.lookup RefId
dId Relationships
sheetRels
        Archive -> ContentTypes -> [Char] -> Either ParseError Drawing
getDrawing Archive
ar ContentTypes
contentTypes (Relationship -> [Char]
relTarget Relationship
rel)
      let ptType :: p
ptType = p
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable"
      [PivotTable]
pivotTables <- [Relationship]
-> (Relationship -> Either ParseError PivotTable)
-> Either ParseError [PivotTable]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Text -> Relationships -> [Relationship]
allByType Text
forall p. IsString p => p
ptType Relationships
sheetRels) ((Relationship -> Either ParseError PivotTable)
 -> Either ParseError [PivotTable])
-> (Relationship -> Either ParseError PivotTable)
-> Either ParseError [PivotTable]
forall a b. (a -> b) -> a -> b
$ \Relationship
rel -> do
        let ptPath :: [Char]
ptPath = Relationship -> [Char]
relTarget Relationship
rel
        ByteString
bs <- ParseError -> Maybe ByteString -> Either ParseError ByteString
forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
ptPath) (Maybe ByteString -> Either ParseError ByteString)
-> Maybe ByteString -> Either ParseError ByteString
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry (Entry -> ByteString) -> Maybe Entry -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
ptPath Archive
ar
        ParseError -> Maybe PivotTable -> Either ParseError PivotTable
forall a b. a -> Maybe b -> Either a b
note (Text -> ParseError
InconsistentXlsx (Text -> ParseError) -> Text -> ParseError
forall a b. (a -> b) -> a -> b
$ Text
"Bad pivot table in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
ptPath) (Maybe PivotTable -> Either ParseError PivotTable)
-> Maybe PivotTable -> Either ParseError PivotTable
forall a b. (a -> b) -> a -> b
$
          (CacheId -> Maybe (Text, Range, [CacheField]))
-> ByteString -> Maybe PivotTable
parsePivotTable ((CacheId -> Caches -> Maybe (Text, Range, [CacheField]))
-> Caches -> CacheId -> Maybe (Text, Range, [CacheField])
forall a b c. (a -> b -> c) -> b -> a -> c
flip CacheId -> Caches -> Maybe (Text, Range, [CacheField])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup Caches
caches) ByteString
bs

      Worksheet -> Parser Worksheet
forall (m :: * -> *) a. Monad m => a -> m a
return (Worksheet -> Parser Worksheet) -> Worksheet -> Parser Worksheet
forall a b. (a -> b) -> a -> b
$ Worksheet
ws Worksheet -> (Worksheet -> Worksheet) -> Worksheet
forall a b. a -> (a -> b) -> b
& ([Table] -> Identity [Table]) -> Worksheet -> Identity Worksheet
Lens' Worksheet [Table]
wsTables (([Table] -> Identity [Table]) -> Worksheet -> Identity Worksheet)
-> [Table] -> Worksheet -> Worksheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Table]
tables
                  Worksheet -> (Worksheet -> Worksheet) -> Worksheet
forall a b. a -> (a -> b) -> b
& (CellMap -> Identity CellMap) -> Worksheet -> Identity Worksheet
Lens' Worksheet CellMap
wsCells ((CellMap -> Identity CellMap) -> Worksheet -> Identity Worksheet)
-> (CellMap -> CellMap) -> Worksheet -> Worksheet
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CellMap -> CellMap
mergeComments
                  Worksheet -> (Worksheet -> Worksheet) -> Worksheet
forall a b. a -> (a -> b) -> b
& (Maybe Drawing -> Identity (Maybe Drawing))
-> Worksheet -> Identity Worksheet
Lens' Worksheet (Maybe Drawing)
wsDrawing ((Maybe Drawing -> Identity (Maybe Drawing))
 -> Worksheet -> Identity Worksheet)
-> Maybe Drawing -> Worksheet -> Worksheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Drawing
drawing
                  Worksheet -> (Worksheet -> Worksheet) -> Worksheet
forall a b. a -> (a -> b) -> b
& ([PivotTable] -> Identity [PivotTable])
-> Worksheet -> Identity Worksheet
Lens' Worksheet [PivotTable]
wsPivotTables (([PivotTable] -> Identity [PivotTable])
 -> Worksheet -> Identity Worksheet)
-> [PivotTable] -> Worksheet -> Worksheet
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [PivotTable]
pivotTables
    liftEither :: Either Text a -> Parser a
    liftEither :: Either Text a -> Parser a
liftEither = (Text -> ParseError) -> Either Text a -> Parser a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (\Text
t -> [Char] -> Text -> ParseError
InvalidFile [Char]
filePath Text
t)
    justNonEmpty :: Maybe [a] -> Maybe [a]
justNonEmpty v :: Maybe [a]
v@(Just (a
_:[a]
_)) = Maybe [a]
v
    justNonEmpty Maybe [a]
_ = Maybe [a]
forall a. Maybe a
Nothing
    collectRows :: t (Int, Maybe RowProperties,
   [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRows = ((Int, Maybe RowProperties,
  [(Int, Int, Cell,
    Maybe (SharedFormulaIndex, SharedFormulaOptions))])
 -> (Map Int RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions)
 -> (Map Int RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions))
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> t (Int, Maybe RowProperties,
      [(Int, Int, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Maybe RowProperties,
 [(Int, Int, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (Map Int RowProperties
forall k a. Map k a
M.empty, CellMap
forall k a. Map k a
M.empty, Map SharedFormulaIndex SharedFormulaOptions
forall k a. Map k a
M.empty)
    collectRow ::
         ( Int
         , Maybe RowProperties
         , [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])
      -> ( Map Int RowProperties
         , CellMap
         , Map SharedFormulaIndex SharedFormulaOptions)
      -> ( Map Int RowProperties
         , CellMap
         , Map SharedFormulaIndex SharedFormulaOptions)
    collectRow :: (Int, Maybe RowProperties,
 [(Int, Int, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (Int
r, Maybe RowProperties
mRP, [(Int, Int, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells) (Map Int RowProperties
rowMap, CellMap
cellMap, Map SharedFormulaIndex SharedFormulaOptions
sharedF) =
      let ([((Int, Int), Cell)]
newCells0, [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0) =
            [(((Int, Int), Cell),
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
-> ([((Int, Int), Cell)],
    [Maybe (SharedFormulaIndex, SharedFormulaOptions)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(((Int
x, Int
y), Cell
cd), Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) | (Int
x, Int
y, Cell
cd, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) <- [(Int, Int, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells]
          newCells :: CellMap
newCells = [((Int, Int), Cell)] -> CellMap
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [((Int, Int), Cell)]
newCells0
          newSharedF :: Map SharedFormulaIndex SharedFormulaOptions
newSharedF = [(SharedFormulaIndex, SharedFormulaOptions)]
-> Map SharedFormulaIndex SharedFormulaOptions
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList ([(SharedFormulaIndex, SharedFormulaOptions)]
 -> Map SharedFormulaIndex SharedFormulaOptions)
-> [(SharedFormulaIndex, SharedFormulaOptions)]
-> Map SharedFormulaIndex SharedFormulaOptions
forall a b. (a -> b) -> a -> b
$ [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
-> [(SharedFormulaIndex, SharedFormulaOptions)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0
          newRowMap :: Map Int RowProperties
newRowMap =
            case Maybe RowProperties
mRP of
              Just RowProperties
rp -> Int
-> RowProperties -> Map Int RowProperties -> Map Int RowProperties
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
r RowProperties
rp Map Int RowProperties
rowMap
              Maybe RowProperties
Nothing -> Map Int RowProperties
rowMap
      in (Map Int RowProperties
newRowMap, CellMap
cellMap CellMap -> CellMap -> CellMap
forall a. Semigroup a => a -> a -> a
<> CellMap
newCells, Map SharedFormulaIndex SharedFormulaOptions
sharedF Map SharedFormulaIndex SharedFormulaOptions
-> Map SharedFormulaIndex SharedFormulaOptions
-> Map SharedFormulaIndex SharedFormulaOptions
forall a. Semigroup a => a -> a -> a
<> Map SharedFormulaIndex SharedFormulaOptions
newSharedF)
    parseRow ::
         Xeno.Node
      -> Either Text ( Int
                     , Maybe RowProperties
                     , [( Int
                        , Int
                        , Cell
                        , Maybe (SharedFormulaIndex, SharedFormulaOptions))])
    parseRow :: Node
-> Either
     Text
     (Int, Maybe RowProperties,
      [(Int, Int, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
parseRow Node
row = do
      (Int
r, Maybe Int
s, Maybe Double
ht, Bool
cstHt, Bool
hidden) <-
        Node
-> AttrParser (Int, Maybe Int, Maybe Double, Bool, Bool)
-> Either Text (Int, Maybe Int, Maybe Double, Bool, Bool)
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
row (AttrParser (Int, Maybe Int, Maybe Double, Bool, Bool)
 -> Either Text (Int, Maybe Int, Maybe Double, Bool, Bool))
-> AttrParser (Int, Maybe Int, Maybe Double, Bool, Bool)
-> Either Text (Int, Maybe Int, Maybe Double, Bool, Bool)
forall a b. (a -> b) -> a -> b
$
        ((,,,,) (Int
 -> Maybe Int
 -> Maybe Double
 -> Bool
 -> Bool
 -> (Int, Maybe Int, Maybe Double, Bool, Bool))
-> AttrParser Int
-> AttrParser
     (Maybe Int
      -> Maybe Double
      -> Bool
      -> Bool
      -> (Int, Maybe Int, Maybe Double, Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Int
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"r" AttrParser
  (Maybe Int
   -> Maybe Double
   -> Bool
   -> Bool
   -> (Int, Maybe Int, Maybe Double, Bool, Bool))
-> AttrParser (Maybe Int)
-> AttrParser
     (Maybe Double
      -> Bool -> Bool -> (Int, Maybe Int, Maybe Double, Bool, Bool))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"s" AttrParser
  (Maybe Double
   -> Bool -> Bool -> (Int, Maybe Int, Maybe Double, Bool, Bool))
-> AttrParser (Maybe Double)
-> AttrParser
     (Bool -> Bool -> (Int, Maybe Int, Maybe Double, Bool, Bool))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser (Maybe Double)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"ht" AttrParser
  (Bool -> Bool -> (Int, Maybe Int, Maybe Double, Bool, Bool))
-> AttrParser Bool
-> AttrParser (Bool -> (Int, Maybe Int, Maybe Double, Bool, Bool))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"customHeight" Bool
False AttrParser (Bool -> (Int, Maybe Int, Maybe Double, Bool, Bool))
-> AttrParser Bool
-> AttrParser (Int, Maybe Int, Maybe Double, Bool, Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         ByteString -> Bool -> AttrParser Bool
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"hidden" Bool
False)
      let props :: RowProperties
props =
            RowProps :: Maybe RowHeight -> Maybe Int -> Bool -> RowProperties
RowProps
            { rowHeight :: Maybe RowHeight
rowHeight =
                if Bool
cstHt
                  then Double -> RowHeight
CustomHeight (Double -> RowHeight) -> Maybe Double -> Maybe RowHeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
ht
                  else Double -> RowHeight
AutomaticHeight (Double -> RowHeight) -> Maybe Double -> Maybe RowHeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
ht
            , rowStyle :: Maybe Int
rowStyle = Maybe Int
s
            , rowHidden :: Bool
rowHidden = Bool
hidden
            }
      [Node]
cellNodes <- Node -> ChildCollector [Node] -> Either Text [Node]
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
row (ChildCollector [Node] -> Either Text [Node])
-> ChildCollector [Node] -> Either Text [Node]
forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"c"
      [(Int, Int, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
cells <- [Node]
-> (Node
    -> Either
         Text
         (Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions)))
-> Either
     Text
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
cellNodes Node
-> Either
     Text
     (Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))
parseCell
      (Int, Maybe RowProperties,
 [(Int, Int, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> Either
     Text
     (Int, Maybe RowProperties,
      [(Int, Int, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( Int
r
        , if RowProperties
props RowProperties -> RowProperties -> Bool
forall a. Eq a => a -> a -> Bool
== RowProperties
forall a. Default a => a
def
            then Maybe RowProperties
forall a. Maybe a
Nothing
            else RowProperties -> Maybe RowProperties
forall a. a -> Maybe a
Just RowProperties
props
        , [(Int, Int, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
cells)
    parseCell ::
         Xeno.Node
      -> Either Text ( Int
                     , Int
                     , Cell
                     , Maybe (SharedFormulaIndex, SharedFormulaOptions))
    parseCell :: Node
-> Either
     Text
     (Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))
parseCell Node
cell = do
      (Range
ref, Maybe Int
s, ByteString
t) <-
        Node
-> AttrParser (Range, Maybe Int, ByteString)
-> Either Text (Range, Maybe Int, ByteString)
forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
cell (AttrParser (Range, Maybe Int, ByteString)
 -> Either Text (Range, Maybe Int, ByteString))
-> AttrParser (Range, Maybe Int, ByteString)
-> Either Text (Range, Maybe Int, ByteString)
forall a b. (a -> b) -> a -> b
$
        (,,) (Range
 -> Maybe Int -> ByteString -> (Range, Maybe Int, ByteString))
-> AttrParser Range
-> AttrParser
     (Maybe Int -> ByteString -> (Range, Maybe Int, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> AttrParser Range
forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"r" AttrParser
  (Maybe Int -> ByteString -> (Range, Maybe Int, ByteString))
-> AttrParser (Maybe Int)
-> AttrParser (ByteString -> (Range, Maybe Int, ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> AttrParser (Maybe Int)
forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"s" AttrParser (ByteString -> (Range, Maybe Int, ByteString))
-> AttrParser ByteString
-> AttrParser (Range, Maybe Int, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ByteString -> AttrParser ByteString
forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"t" ByteString
"n"
      (Maybe Node
fNode, Maybe Node
vNode, Maybe Node
isNode) <-
        Node
-> ChildCollector (Maybe Node, Maybe Node, Maybe Node)
-> Either Text (Maybe Node, Maybe Node, Maybe Node)
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
cell (ChildCollector (Maybe Node, Maybe Node, Maybe Node)
 -> Either Text (Maybe Node, Maybe Node, Maybe Node))
-> ChildCollector (Maybe Node, Maybe Node, Maybe Node)
-> Either Text (Maybe Node, Maybe Node, Maybe Node)
forall a b. (a -> b) -> a -> b
$
        (,,) (Maybe Node
 -> Maybe Node
 -> Maybe Node
 -> (Maybe Node, Maybe Node, Maybe Node))
-> ChildCollector (Maybe Node)
-> ChildCollector
     (Maybe Node -> Maybe Node -> (Maybe Node, Maybe Node, Maybe Node))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ChildCollector (Maybe Node)
maybeChild ByteString
"f" ChildCollector
  (Maybe Node -> Maybe Node -> (Maybe Node, Maybe Node, Maybe Node))
-> ChildCollector (Maybe Node)
-> ChildCollector
     (Maybe Node -> (Maybe Node, Maybe Node, Maybe Node))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ChildCollector (Maybe Node)
maybeChild ByteString
"v" ChildCollector (Maybe Node -> (Maybe Node, Maybe Node, Maybe Node))
-> ChildCollector (Maybe Node)
-> ChildCollector (Maybe Node, Maybe Node, Maybe Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ChildCollector (Maybe Node)
maybeChild ByteString
"is"
      let vConverted :: (FromAttrBs a) => Either Text (Maybe a)
          vConverted :: Either Text (Maybe a)
vConverted =
            case Node -> ByteString
contentBs (Node -> ByteString) -> Maybe Node -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Node
vNode of
              Maybe ByteString
Nothing -> Maybe a -> Either Text (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
              Just ByteString
c -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either Text a -> Either Text (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either Text a
forall a. FromAttrBs a => ByteString -> Either Text a
fromAttrBs ByteString
c
      Maybe FormulaData
mFormulaData <- (Node -> Either Text FormulaData)
-> Maybe Node -> Either Text (Maybe FormulaData)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node -> Either Text FormulaData
forall a. FromXenoNode a => Node -> Either Text a
fromXenoNode Maybe Node
fNode
      Maybe CellValue
d <-
        case ByteString
t of
          (ByteString
"s" :: ByteString) -> do
            Maybe Int
si <- Either Text (Maybe Int)
forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
            case SharedStringTable -> Int -> Maybe XlsxText
sstItem SharedStringTable
sst (Int -> Maybe XlsxText) -> Maybe Int -> Maybe XlsxText
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
si of
              Just XlsxText
xlTxt -> Maybe CellValue -> Either Text (Maybe CellValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CellValue -> Either Text (Maybe CellValue))
-> Maybe CellValue -> Either Text (Maybe CellValue)
forall a b. (a -> b) -> a -> b
$ CellValue -> Maybe CellValue
forall a. a -> Maybe a
Just (XlsxText -> CellValue
xlsxTextToCellValue XlsxText
xlTxt)
              Maybe XlsxText
Nothing -> Text -> Either Text (Maybe CellValue)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"bad shared string index"
          ByteString
"inlineStr" -> (Node -> Either Text CellValue)
-> Maybe Node -> Either Text (Maybe CellValue)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((XlsxText -> CellValue)
-> Either Text XlsxText -> Either Text CellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XlsxText -> CellValue
xlsxTextToCellValue (Either Text XlsxText -> Either Text CellValue)
-> (Node -> Either Text XlsxText) -> Node -> Either Text CellValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Either Text XlsxText
forall a. FromXenoNode a => Node -> Either Text a
fromXenoNode) Maybe Node
isNode
          ByteString
"str" -> (Text -> CellValue) -> Maybe Text -> Maybe CellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> CellValue
CellText (Maybe Text -> Maybe CellValue)
-> Either Text (Maybe Text) -> Either Text (Maybe CellValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Maybe Text)
forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
"n" -> (Double -> CellValue) -> Maybe Double -> Maybe CellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> CellValue
CellDouble (Maybe Double -> Maybe CellValue)
-> Either Text (Maybe Double) -> Either Text (Maybe CellValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Maybe Double)
forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
"b" -> (Bool -> CellValue) -> Maybe Bool -> Maybe CellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> CellValue
CellBool (Maybe Bool -> Maybe CellValue)
-> Either Text (Maybe Bool) -> Either Text (Maybe CellValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Maybe Bool)
forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
"e" -> (ErrorType -> CellValue) -> Maybe ErrorType -> Maybe CellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorType -> CellValue
CellError (Maybe ErrorType -> Maybe CellValue)
-> Either Text (Maybe ErrorType) -> Either Text (Maybe CellValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Maybe ErrorType)
forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
unexpected ->
            Text -> Either Text (Maybe CellValue)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> Either Text (Maybe CellValue))
-> Text -> Either Text (Maybe CellValue)
forall a b. (a -> b) -> a -> b
$ Text
"unexpected cell type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
unexpected)
      let (Int
r, Int
c) = Range -> (Int, Int)
fromSingleCellRefNoting Range
ref
          f :: Maybe CellFormula
f = FormulaData -> CellFormula
frmdFormula (FormulaData -> CellFormula)
-> Maybe FormulaData -> Maybe CellFormula
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FormulaData
mFormulaData
          shared :: Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared = FormulaData -> Maybe (SharedFormulaIndex, SharedFormulaOptions)
frmdShared (FormulaData -> Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe FormulaData
-> Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe FormulaData
mFormulaData
      (Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Either
     Text
     (Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
r, Int
c, Maybe Int
-> Maybe CellValue -> Maybe Comment -> Maybe CellFormula -> Cell
Cell Maybe Int
s Maybe CellValue
d Maybe Comment
forall a. Maybe a
Nothing Maybe CellFormula
f, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared)

extractSheet ::
     Zip.Archive
  -> SharedStringTable
  -> ContentTypes
  -> Caches
  -> WorksheetFile
  -> Parser Worksheet
extractSheet :: Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
extractSheet Archive
ar SharedStringTable
sst ContentTypes
contentTypes Caches
caches WorksheetFile
wf = do
  let filePath :: [Char]
filePath = WorksheetFile -> [Char]
wfPath WorksheetFile
wf
  ByteString
file <- ParseError -> Maybe ByteString -> Either ParseError ByteString
forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
filePath) (Maybe ByteString -> Either ParseError ByteString)
-> Maybe ByteString -> Either ParseError ByteString
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry (Entry -> ByteString) -> Maybe Entry -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
filePath Archive
ar
  Cursor
cur <- (Document -> Cursor)
-> Either ParseError Document -> Either ParseError Cursor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Document -> Cursor
fromDocument (Either ParseError Document -> Either ParseError Cursor)
-> (Either SomeException Document -> Either ParseError Document)
-> Either SomeException Document
-> Either ParseError Cursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> ParseError)
-> Either SomeException Document -> Either ParseError Document
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (\SomeException
ex -> [Char] -> Text -> ParseError
InvalidFile [Char]
filePath ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
ex)) (Either SomeException Document -> Either ParseError Cursor)
-> Either SomeException Document -> Either ParseError Cursor
forall a b. (a -> b) -> a -> b
$
         ParseSettings -> ByteString -> Either SomeException Document
parseLBS ParseSettings
forall a. Default a => a
def ByteString
file
  Relationships
sheetRels <- Archive -> [Char] -> Parser Relationships
getRels Archive
ar [Char]
filePath

  -- The specification says the file should contain either 0 or 1 @sheetViews@
  -- (4th edition, section 18.3.1.88, p. 1704 and definition CT_Worksheet, p. 3910)
  let  sheetViewList :: [a]
sheetViewList = Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheetViews") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"sheetView") 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
       sheetViews :: Maybe [a]
sheetViews = case [a]
forall a. FromCursor a => [a]
sheetViewList of
         []    -> Maybe [a]
forall a. Maybe a
Nothing
         [a]
views -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
views

  let commentsType :: p
commentsType = p
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments"
      commentTarget :: Maybe FilePath
      commentTarget :: Maybe [Char]
commentTarget = Relationship -> [Char]
relTarget (Relationship -> [Char]) -> Maybe Relationship -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Relationships -> Maybe Relationship
findRelByType Text
forall p. IsString p => p
commentsType Relationships
sheetRels
      legacyDrRId :: [a]
legacyDrRId = Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"legacyDrawing") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [a]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute (Text -> Name
odrText
"id")
      legacyDrPath :: Maybe [Char]
legacyDrPath = (Relationship -> [Char]) -> Maybe Relationship -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Relationship -> [Char]
relTarget (Maybe Relationship -> Maybe [Char])
-> (RefId -> Maybe Relationship) -> RefId -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RefId -> Relationships -> Maybe Relationship)
-> Relationships -> RefId -> Maybe Relationship
forall a b c. (a -> b -> c) -> b -> a -> c
flip RefId -> Relationships -> Maybe Relationship
Relationships.lookup Relationships
sheetRels  (RefId -> Maybe [Char]) -> Maybe RefId -> Maybe [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [RefId] -> Maybe RefId
forall a. [a] -> Maybe a
listToMaybe [RefId]
forall a. FromAttrVal a => [a]
legacyDrRId

  Maybe CommentTable
commentsMap :: Maybe CommentTable <- Either ParseError (Maybe CommentTable)
-> ([Char] -> Either ParseError (Maybe CommentTable))
-> Maybe [Char]
-> Either ParseError (Maybe CommentTable)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe CommentTable -> Either ParseError (Maybe CommentTable)
forall a b. b -> Either a b
Right Maybe CommentTable
forall a. Maybe a
Nothing) (Archive
-> Maybe [Char] -> [Char] -> Either ParseError (Maybe CommentTable)
getComments Archive
ar Maybe [Char]
legacyDrPath) Maybe [Char]
commentTarget

  -- Likewise, @pageSetup@ also occurs either 0 or 1 times
  let pageSetup :: Maybe a
pageSetup = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"pageSetup") 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

      cws :: [a]
cws = Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"cols") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"col") 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

      (Map Int RowProperties
rowProps, CellMap
cells0, Map SharedFormulaIndex SharedFormulaOptions
sharedFormulas) =
        [(Int, Maybe RowProperties,
  [(Int, Int, Cell,
    Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
forall (t :: * -> *).
Foldable t =>
t (Int, Maybe RowProperties,
   [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collect ([(Int, Maybe RowProperties,
   [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
 -> (Map Int RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions))
-> [(Int, Maybe RowProperties,
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor
-> (Cursor
    -> [(Int, Maybe RowProperties,
         [(Int, Int, Cell,
           Maybe (SharedFormulaIndex, SharedFormulaOptions))])])
-> [(Int, Maybe RowProperties,
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheetData") Axis
-> (Cursor
    -> [(Int, Maybe RowProperties,
         [(Int, Int, Cell,
           Maybe (SharedFormulaIndex, SharedFormulaOptions))])])
-> Cursor
-> [(Int, Maybe RowProperties,
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"row") Axis
-> (Cursor
    -> [(Int, Maybe RowProperties,
         [(Int, Int, Cell,
           Maybe (SharedFormulaIndex, SharedFormulaOptions))])])
-> Cursor
-> [(Int, Maybe RowProperties,
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor
-> [(Int, Maybe RowProperties,
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
parseRow
      parseRow ::
           Cursor
        -> [( Int
            , Maybe RowProperties
            , [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
      parseRow :: Cursor
-> [(Int, Maybe RowProperties,
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
parseRow Cursor
c = do
        Int
r <- Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"r" Cursor
c
        let prop :: RowProperties
prop = RowProps :: Maybe RowHeight -> Maybe Int -> Bool -> RowProperties
RowProps
              { rowHeight :: Maybe RowHeight
rowHeight = do Double
h <- [Double] -> Maybe Double
forall a. [a] -> Maybe a
listToMaybe ([Double] -> Maybe Double) -> [Double] -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Double]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"ht" Cursor
c
                               case Name -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"customHeight" Cursor
c of
                                 [Bool
True] -> RowHeight -> Maybe RowHeight
forall (m :: * -> *) a. Monad m => a -> m a
return (RowHeight -> Maybe RowHeight) -> RowHeight -> Maybe RowHeight
forall a b. (a -> b) -> a -> b
$ Double -> RowHeight
CustomHeight    Double
h
                                 [Bool]
_      -> RowHeight -> Maybe RowHeight
forall (m :: * -> *) a. Monad m => a -> m a
return (RowHeight -> Maybe RowHeight) -> RowHeight -> Maybe RowHeight
forall a b. (a -> b) -> a -> b
$ Double -> RowHeight
AutomaticHeight Double
h
              , rowStyle :: Maybe Int
rowStyle  = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe ([Int] -> Maybe Int) -> [Int] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"s" Cursor
c
              , rowHidden :: Bool
rowHidden =
                  case Name -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"hidden" Cursor
c of
                    []  -> Bool
False
                    Bool
f:[Bool]
_ -> Bool
f
              }
        (Int, Maybe RowProperties,
 [(Int, Int, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> [(Int, Maybe RowProperties,
     [(Int, Int, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
forall (m :: * -> *) a. Monad m => a -> m a
return ( Int
r
               , if RowProperties
prop RowProperties -> RowProperties -> Bool
forall a. Eq a => a -> a -> Bool
== RowProperties
forall a. Default a => a
def then Maybe RowProperties
forall a. Maybe a
Nothing else RowProperties -> Maybe RowProperties
forall a. a -> Maybe a
Just RowProperties
prop
               , Cursor
c Cursor
-> (Cursor
    -> [(Int, Int, Cell,
         Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"c") Axis
-> (Cursor
    -> [(Int, Int, Cell,
         Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> Cursor
-> [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor
-> [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
parseCell
               )
      parseCell ::
           Cursor
        -> [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
      parseCell :: Cursor
-> [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
parseCell Cursor
cell = do
        Range
ref <- Name -> Cursor -> [Range]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"r" Cursor
cell
        let s :: Maybe a
s = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Cursor
cell Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Name -> Cursor -> [Text]
attribute Name
"s" (Cursor -> [Text]) -> (Text -> [a]) -> Cursor -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [a]
forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
            t :: Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"n" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Cursor
cell Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> a) -> a
$| Name -> Cursor -> [Text]
attribute Name
"t"
            d :: Maybe CellValue
d = [CellValue] -> Maybe CellValue
forall a. [a] -> Maybe a
listToMaybe ([CellValue] -> Maybe CellValue) -> [CellValue] -> Maybe CellValue
forall a b. (a -> b) -> a -> b
$ SharedStringTable -> Text -> Cursor -> [CellValue]
extractCellValue SharedStringTable
sst Text
t Cursor
cell
            mFormulaData :: Maybe
  (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
mFormulaData = [(CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
-> Maybe
     (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
forall a. [a] -> Maybe a
listToMaybe ([(CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
 -> Maybe
      (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions)))
-> [(CellFormula,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
-> Maybe
     (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
forall a b. (a -> b) -> a -> b
$ Cursor
cell Cursor
-> (Cursor
    -> [(CellFormula,
         Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> [(CellFormula,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"f") Axis
-> (Cursor
    -> [(CellFormula,
         Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> Cursor
-> [(CellFormula,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor
-> [(CellFormula,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
formulaDataFromCursor
            f :: Maybe CellFormula
f = (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> CellFormula
forall a b. (a, b) -> a
fst ((CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
 -> CellFormula)
-> Maybe
     (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe CellFormula
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
mFormulaData
            shared :: Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared = (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall a b. (a, b) -> b
snd ((CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
 -> Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe
     (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> Maybe (SharedFormulaIndex, SharedFormulaOptions)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe
  (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
mFormulaData
            (Int
r, Int
c) = Range -> (Int, Int)
fromSingleCellRefNoting Range
ref
            comment :: Maybe Comment
comment = Maybe CommentTable
commentsMap Maybe CommentTable
-> (CommentTable -> Maybe Comment) -> Maybe Comment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Range -> CommentTable -> Maybe Comment
lookupComment Range
ref
        (Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))
-> [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
r, Int
c, Maybe Int
-> Maybe CellValue -> Maybe Comment -> Maybe CellFormula -> Cell
Cell Maybe Int
forall a. Integral a => Maybe a
s Maybe CellValue
d Maybe Comment
comment Maybe CellFormula
f, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared)
      collect :: t (Int, Maybe RowProperties,
   [(Int, Int, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collect = ((Int, Maybe RowProperties,
  [(Int, Int, Cell,
    Maybe (SharedFormulaIndex, SharedFormulaOptions))])
 -> (Map Int RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions)
 -> (Map Int RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions))
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> t (Int, Maybe RowProperties,
      [(Int, Int, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int, Maybe RowProperties,
 [(Int, Int, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (Map Int RowProperties
forall k a. Map k a
M.empty, CellMap
forall k a. Map k a
M.empty, Map SharedFormulaIndex SharedFormulaOptions
forall k a. Map k a
M.empty)
      collectRow ::
           ( Int
           , Maybe RowProperties
           , [(Int, Int, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])
        -> (Map Int RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)
        -> (Map Int RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)
      collectRow :: (Int, Maybe RowProperties,
 [(Int, Int, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map Int RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (Int
r, Maybe RowProperties
mRP, [(Int, Int, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells) (Map Int RowProperties
rowMap, CellMap
cellMap, Map SharedFormulaIndex SharedFormulaOptions
sharedF) =
        let ([((Int, Int), Cell)]
newCells0, [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0) =
              [(((Int, Int), Cell),
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
-> ([((Int, Int), Cell)],
    [Maybe (SharedFormulaIndex, SharedFormulaOptions)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(((Int
x,Int
y),Cell
cd), Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) | (Int
x, Int
y, Cell
cd, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) <- [(Int, Int, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells]
            newCells :: CellMap
newCells = [((Int, Int), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((Int, Int), Cell)]
newCells0
            newSharedF :: Map SharedFormulaIndex SharedFormulaOptions
newSharedF = [(SharedFormulaIndex, SharedFormulaOptions)]
-> Map SharedFormulaIndex SharedFormulaOptions
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SharedFormulaIndex, SharedFormulaOptions)]
 -> Map SharedFormulaIndex SharedFormulaOptions)
-> [(SharedFormulaIndex, SharedFormulaOptions)]
-> Map SharedFormulaIndex SharedFormulaOptions
forall a b. (a -> b) -> a -> b
$ [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
-> [(SharedFormulaIndex, SharedFormulaOptions)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0
            newRowMap :: Map Int RowProperties
newRowMap = case Maybe RowProperties
mRP of
              Just RowProperties
rp -> Int
-> RowProperties -> Map Int RowProperties -> Map Int RowProperties
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
r RowProperties
rp Map Int RowProperties
rowMap
              Maybe RowProperties
Nothing -> Map Int RowProperties
rowMap
        in (Map Int RowProperties
newRowMap, CellMap
cellMap CellMap -> CellMap -> CellMap
forall a. Semigroup a => a -> a -> a
<> CellMap
newCells, Map SharedFormulaIndex SharedFormulaOptions
sharedF Map SharedFormulaIndex SharedFormulaOptions
-> Map SharedFormulaIndex SharedFormulaOptions
-> Map SharedFormulaIndex SharedFormulaOptions
forall a. Semigroup a => a -> a -> a
<> Map SharedFormulaIndex SharedFormulaOptions
newSharedF)

      commentCells :: CellMap
commentCells =
        [((Int, Int), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
          [ (Range -> (Int, Int)
fromSingleCellRefNoting Range
r, Cell
forall a. Default a => a
def {_cellComment :: Maybe Comment
_cellComment = Comment -> Maybe Comment
forall a. a -> Maybe a
Just Comment
cmnt})
          | (Range
r, Comment
cmnt) <- [(Range, Comment)]
-> (CommentTable -> [(Range, Comment)])
-> Maybe CommentTable
-> [(Range, Comment)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CommentTable -> [(Range, Comment)]
CommentTable.toList Maybe CommentTable
commentsMap
          ]
      cells :: CellMap
cells = CellMap
cells0 CellMap -> CellMap -> CellMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` CellMap
commentCells

      mProtection :: Maybe a
mProtection = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheetProtection") 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

      mDrawingId :: Maybe a
mDrawingId = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"drawing") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [a]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute (Text -> Name
odrText
"id")

      merges :: [Range]
merges = Cursor
cur Cursor -> (Cursor -> [Range]) -> [Range]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Range]
parseMerges
      parseMerges :: Cursor -> [Range]
      parseMerges :: Cursor -> [Range]
parseMerges = Name -> Axis
element (Text -> Name
n_ Text
"mergeCells") Axis -> (Cursor -> [Range]) -> Cursor -> [Range]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"mergeCell") 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"

      condFormtattings :: Map SqRef ConditionalFormatting
condFormtattings = [(SqRef, ConditionalFormatting)] -> Map SqRef ConditionalFormatting
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SqRef, ConditionalFormatting)]
 -> Map SqRef ConditionalFormatting)
-> ([CfPair] -> [(SqRef, ConditionalFormatting)])
-> [CfPair]
-> Map SqRef ConditionalFormatting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CfPair -> (SqRef, ConditionalFormatting))
-> [CfPair] -> [(SqRef, ConditionalFormatting)]
forall a b. (a -> b) -> [a] -> [b]
map CfPair -> (SqRef, ConditionalFormatting)
unCfPair  ([CfPair] -> Map SqRef ConditionalFormatting)
-> [CfPair] -> Map SqRef ConditionalFormatting
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [CfPair]) -> [CfPair]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"conditionalFormatting") Axis -> (Cursor -> [CfPair]) -> Cursor -> [CfPair]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [CfPair]
forall a. FromCursor a => Cursor -> [a]
fromCursor

      validations :: Map SqRef DataValidation
validations = [(SqRef, DataValidation)] -> Map SqRef DataValidation
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SqRef, DataValidation)] -> Map SqRef DataValidation)
-> ([DvPair] -> [(SqRef, DataValidation)])
-> [DvPair]
-> Map SqRef DataValidation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DvPair -> (SqRef, DataValidation))
-> [DvPair] -> [(SqRef, DataValidation)]
forall a b. (a -> b) -> [a] -> [b]
map DvPair -> (SqRef, DataValidation)
unDvPair ([DvPair] -> Map SqRef DataValidation)
-> [DvPair] -> Map SqRef DataValidation
forall a b. (a -> b) -> a -> b
$
          Cursor
cur Cursor -> (Cursor -> [DvPair]) -> [DvPair]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"dataValidations") Axis -> (Cursor -> [DvPair]) -> Cursor -> [DvPair]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"dataValidation") Axis -> (Cursor -> [DvPair]) -> Cursor -> [DvPair]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [DvPair]
forall a. FromCursor a => Cursor -> [a]
fromCursor

      tableIds :: [a]
tableIds =
        Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"tableParts") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"tablePart") Axis -> (Cursor -> [a]) -> Cursor -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        Name -> Cursor -> [a]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute (Text -> Name
odr Text
"id")

  let mAutoFilter :: Maybe a
mAutoFilter = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Cursor
cur Cursor -> (Cursor -> [a]) -> [a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"autoFilter") 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

  Maybe Drawing
mDrawing <- case Maybe RefId
forall a. FromAttrVal a => Maybe a
mDrawingId of
      Just RefId
dId -> do
          Relationship
rel <- ParseError -> Maybe Relationship -> Either ParseError Relationship
forall a b. a -> Maybe b -> Either a b
note ([Char] -> RefId -> ParseError
InvalidRef [Char]
filePath RefId
dId) (Maybe Relationship -> Either ParseError Relationship)
-> Maybe Relationship -> Either ParseError Relationship
forall a b. (a -> b) -> a -> b
$ RefId -> Relationships -> Maybe Relationship
Relationships.lookup RefId
dId Relationships
sheetRels
          Drawing -> Maybe Drawing
forall a. a -> Maybe a
Just (Drawing -> Maybe Drawing)
-> Either ParseError Drawing -> Either ParseError (Maybe Drawing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Archive -> ContentTypes -> [Char] -> Either ParseError Drawing
getDrawing Archive
ar ContentTypes
contentTypes (Relationship -> [Char]
relTarget Relationship
rel)
      Maybe RefId
Nothing  ->
          Maybe Drawing -> Either ParseError (Maybe Drawing)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drawing
forall a. Maybe a
Nothing

  let ptType :: p
ptType = p
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable"
  [PivotTable]
pTables <- [Relationship]
-> (Relationship -> Either ParseError PivotTable)
-> Either ParseError [PivotTable]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Text -> Relationships -> [Relationship]
allByType Text
forall p. IsString p => p
ptType Relationships
sheetRels) ((Relationship -> Either ParseError PivotTable)
 -> Either ParseError [PivotTable])
-> (Relationship -> Either ParseError PivotTable)
-> Either ParseError [PivotTable]
forall a b. (a -> b) -> a -> b
$ \Relationship
rel -> do
    let ptPath :: [Char]
ptPath = Relationship -> [Char]
relTarget Relationship
rel
    ByteString
bs <- ParseError -> Maybe ByteString -> Either ParseError ByteString
forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
ptPath) (Maybe ByteString -> Either ParseError ByteString)
-> Maybe ByteString -> Either ParseError ByteString
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry (Entry -> ByteString) -> Maybe Entry -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
ptPath Archive
ar
    ParseError -> Maybe PivotTable -> Either ParseError PivotTable
forall a b. a -> Maybe b -> Either a b
note (Text -> ParseError
InconsistentXlsx (Text -> ParseError) -> Text -> ParseError
forall a b. (a -> b) -> a -> b
$ Text
"Bad pivot table in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
ptPath) (Maybe PivotTable -> Either ParseError PivotTable)
-> Maybe PivotTable -> Either ParseError PivotTable
forall a b. (a -> b) -> a -> b
$
      (CacheId -> Maybe (Text, Range, [CacheField]))
-> ByteString -> Maybe PivotTable
parsePivotTable ((CacheId -> Caches -> Maybe (Text, Range, [CacheField]))
-> Caches -> CacheId -> Maybe (Text, Range, [CacheField])
forall a b c. (a -> b -> c) -> b -> a -> c
flip CacheId -> Caches -> Maybe (Text, Range, [CacheField])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup Caches
caches) ByteString
bs

  [Table]
tables <- [RefId]
-> (RefId -> Either ParseError Table) -> Either ParseError [Table]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RefId]
forall a. FromAttrVal a => [a]
tableIds ((RefId -> Either ParseError Table) -> Either ParseError [Table])
-> (RefId -> Either ParseError Table) -> Either ParseError [Table]
forall a b. (a -> b) -> a -> b
$ \RefId
rId -> do
    [Char]
fp <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
filePath Relationships
sheetRels RefId
rId
    Archive -> [Char] -> Either ParseError Table
getTable Archive
ar [Char]
fp

  Worksheet -> Parser Worksheet
forall (m :: * -> *) a. Monad m => a -> m a
return (Worksheet -> Parser Worksheet) -> Worksheet -> Parser Worksheet
forall a b. (a -> b) -> a -> b
$
    [ColumnsProperties]
-> Map Int RowProperties
-> CellMap
-> Maybe Drawing
-> [Range]
-> Maybe [SheetView]
-> Maybe PageSetup
-> Map SqRef ConditionalFormatting
-> Map SqRef DataValidation
-> [PivotTable]
-> Maybe AutoFilter
-> [Table]
-> Maybe SheetProtection
-> Map SharedFormulaIndex SharedFormulaOptions
-> Worksheet
Worksheet
      [ColumnsProperties]
forall a. FromCursor a => [a]
cws
      Map Int RowProperties
rowProps
      CellMap
cells
      Maybe Drawing
mDrawing
      [Range]
merges
      Maybe [SheetView]
forall a. FromCursor a => Maybe [a]
sheetViews
      Maybe PageSetup
forall a. FromCursor a => Maybe a
pageSetup
      Map SqRef ConditionalFormatting
condFormtattings
      Map SqRef DataValidation
validations
      [PivotTable]
pTables
      Maybe AutoFilter
forall a. FromCursor a => Maybe a
mAutoFilter
      [Table]
tables
      Maybe SheetProtection
forall a. FromCursor a => Maybe a
mProtection
      Map SharedFormulaIndex SharedFormulaOptions
sharedFormulas

extractCellValue :: SharedStringTable -> Text -> Cursor -> [CellValue]
extractCellValue :: SharedStringTable -> Text -> Cursor -> [CellValue]
extractCellValue SharedStringTable
sst Text
t Cursor
cur
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"s" = do
    Int
si <- [Char] -> [Int]
forall b. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"shared string"
    case SharedStringTable -> Int -> Maybe XlsxText
sstItem SharedStringTable
sst Int
si of
      Just XlsxText
xlTxt -> CellValue -> [CellValue]
forall (m :: * -> *) a. Monad m => a -> m a
return (CellValue -> [CellValue]) -> CellValue -> [CellValue]
forall a b. (a -> b) -> a -> b
$ XlsxText -> CellValue
xlsxTextToCellValue XlsxText
xlTxt
      Maybe XlsxText
Nothing -> [Char] -> [CellValue]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"bad shared string index"
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"inlineStr" =
    Cursor
cur Cursor -> (Cursor -> [CellValue]) -> [CellValue]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"is") Axis -> (Cursor -> [CellValue]) -> Cursor -> [CellValue]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (XlsxText -> CellValue) -> [XlsxText] -> [CellValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XlsxText -> CellValue
xlsxTextToCellValue ([XlsxText] -> [CellValue])
-> (Cursor -> [XlsxText]) -> Cursor -> [CellValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [XlsxText]
forall a. FromCursor a => Cursor -> [a]
fromCursor
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"str" = Text -> CellValue
CellText (Text -> CellValue) -> [Text] -> [CellValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Text]
forall b. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"string"
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"n" = Double -> CellValue
CellDouble (Double -> CellValue) -> [Double] -> [CellValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Double]
forall b. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"double"
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"b" = Bool -> CellValue
CellBool (Bool -> CellValue) -> [Bool] -> [CellValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Bool]
forall b. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"boolean"
  | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"e" = ErrorType -> CellValue
CellError (ErrorType -> CellValue) -> [ErrorType] -> [CellValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [ErrorType]
forall b. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"error"
  | Bool
otherwise = [Char] -> [CellValue]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"bad cell value"
  where
    vConverted :: [Char] -> [b]
vConverted [Char]
typeStr = do
      Text
vContent <- Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"v") Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
c ->
        Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content)
      case Reader b
forall a. FromAttrVal a => Reader a
fromAttrVal Text
vContent of
        Right (b
val, Text
_) -> b -> [b]
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> [b]) -> b -> [b]
forall a b. (a -> b) -> a -> b
$ b
val
        Either [Char] (b, Text)
_ -> [Char] -> [b]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> [b]) -> [Char] -> [b]
forall a b. (a -> b) -> a -> b
$ [Char]
"bad " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
typeStr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" cell value"

-- | Get xml cursor from the specified file inside the zip archive.
xmlCursorOptional :: Zip.Archive -> FilePath -> Parser (Maybe Cursor)
xmlCursorOptional :: Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
ar [Char]
fname =
    (Cursor -> Maybe Cursor
forall a. a -> Maybe a
Just (Cursor -> Maybe Cursor)
-> Either ParseError Cursor -> Parser (Maybe Cursor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
fname) Parser (Maybe Cursor)
-> (ParseError -> Parser (Maybe Cursor)) -> Parser (Maybe Cursor)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ParseError -> Parser (Maybe Cursor)
forall a. ParseError -> Either ParseError (Maybe a)
missingToNothing
  where
    missingToNothing :: ParseError -> Either ParseError (Maybe a)
    missingToNothing :: ParseError -> Either ParseError (Maybe a)
missingToNothing (MissingFile [Char]
_) = Maybe a -> Either ParseError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    missingToNothing ParseError
other           = ParseError -> Either ParseError (Maybe a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ParseError
other

-- | Get xml cursor from the given file, failing with MissingFile if not found.
xmlCursorRequired :: Zip.Archive -> FilePath -> Parser Cursor
xmlCursorRequired :: Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
fname = do
    Entry
entry <- ParseError -> Maybe Entry -> Either ParseError Entry
forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
fname) (Maybe Entry -> Either ParseError Entry)
-> Maybe Entry -> Either ParseError Entry
forall a b. (a -> b) -> a -> b
$ [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
fname Archive
ar
    Document
cur <- (SomeException -> ParseError)
-> Either SomeException Document -> Either ParseError Document
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (\SomeException
ex -> [Char] -> Text -> ParseError
InvalidFile [Char]
fname ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
ex)) (Either SomeException Document -> Either ParseError Document)
-> Either SomeException Document -> Either ParseError Document
forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Either SomeException Document
parseLBS ParseSettings
forall a. Default a => a
def (Entry -> ByteString
Zip.fromEntry Entry
entry)
    Cursor -> Either ParseError Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return (Cursor -> Either ParseError Cursor)
-> Cursor -> Either ParseError Cursor
forall a b. (a -> b) -> a -> b
$ Document -> Cursor
fromDocument Document
cur

fromFileCursorDef ::
     FromCursor a => Zip.Archive -> FilePath -> Text -> a -> Parser a
fromFileCursorDef :: Archive -> [Char] -> Text -> a -> Parser a
fromFileCursorDef Archive
x [Char]
fp Text
contentsDescr a
defVal = do
  Maybe Cursor
mCur <- Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
x [Char]
fp
  case Maybe Cursor
mCur of
    Just Cursor
cur ->
      ParseError -> [a] -> Parser a
forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp (Text -> ParseError) -> Text -> ParseError
forall a b. (a -> b) -> a -> b
$ Text
"Couldn't parse " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contentsDescr) ([a] -> Parser a) -> [a] -> Parser a
forall a b. (a -> b) -> a -> b
$ Cursor -> [a]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    Maybe Cursor
Nothing -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
defVal

fromFileCursor :: FromCursor a => Zip.Archive -> FilePath -> Text -> Parser a
fromFileCursor :: Archive -> [Char] -> Text -> Parser a
fromFileCursor Archive
x [Char]
fp Text
contentsDescr = do
  Cursor
cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
x [Char]
fp
  ParseError -> [a] -> Parser a
forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp (Text -> ParseError) -> Text -> ParseError
forall a b. (a -> b) -> a -> b
$ Text
"Couldn't parse " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contentsDescr) ([a] -> Parser a) -> [a] -> Parser a
forall a b. (a -> b) -> a -> b
$ Cursor -> [a]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur

-- | Get shared string table
getSharedStrings  :: Zip.Archive -> Parser SharedStringTable
getSharedStrings :: Archive -> Parser SharedStringTable
getSharedStrings Archive
x =
  Archive
-> [Char] -> Text -> SharedStringTable -> Parser SharedStringTable
forall a.
FromCursor a =>
Archive -> [Char] -> Text -> a -> Parser a
fromFileCursorDef Archive
x [Char]
"xl/sharedStrings.xml" Text
"shared strings" SharedStringTable
sstEmpty

getContentTypes :: Zip.Archive -> Parser ContentTypes
getContentTypes :: Archive -> Parser ContentTypes
getContentTypes Archive
x = Archive -> [Char] -> Text -> Parser ContentTypes
forall a. FromCursor a => Archive -> [Char] -> Text -> Parser a
fromFileCursor Archive
x [Char]
"[Content_Types].xml" Text
"content types"

getStyles :: Zip.Archive -> Styles
getStyles :: Archive -> Styles
getStyles Archive
ar = case Entry -> ByteString
Zip.fromEntry (Entry -> ByteString) -> Maybe Entry -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
"xl/styles.xml" Archive
ar of
  Maybe ByteString
Nothing  -> ByteString -> Styles
Styles ByteString
L.empty
  Just ByteString
xml -> ByteString -> Styles
Styles ByteString
xml

getComments :: Zip.Archive -> Maybe FilePath -> FilePath -> Parser (Maybe CommentTable)
getComments :: Archive
-> Maybe [Char] -> [Char] -> Either ParseError (Maybe CommentTable)
getComments Archive
ar Maybe [Char]
drp [Char]
fp = do
    Maybe Cursor
mCurComments <- Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
ar [Char]
fp
    Maybe Cursor
mCurDr <- Parser (Maybe Cursor)
-> ([Char] -> Parser (Maybe Cursor))
-> Maybe [Char]
-> Parser (Maybe Cursor)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Cursor -> Parser (Maybe Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Cursor
forall a. Maybe a
Nothing) (Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
ar) Maybe [Char]
drp
    Maybe CommentTable -> Either ParseError (Maybe CommentTable)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Range] -> CommentTable -> CommentTable)
-> Maybe [Range] -> Maybe CommentTable -> Maybe CommentTable
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Range] -> CommentTable -> CommentTable
forall (t :: * -> *).
Foldable t =>
t Range -> CommentTable -> CommentTable
hide (Cursor -> [Range]
hidden (Cursor -> [Range]) -> Maybe Cursor -> Maybe [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Cursor
mCurDr) (Maybe CommentTable -> Maybe CommentTable)
-> (Cursor -> Maybe CommentTable) -> Cursor -> Maybe CommentTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommentTable] -> Maybe CommentTable
forall a. [a] -> Maybe a
listToMaybe ([CommentTable] -> Maybe CommentTable)
-> (Cursor -> [CommentTable]) -> Cursor -> Maybe CommentTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [CommentTable]
forall a. FromCursor a => Cursor -> [a]
fromCursor (Cursor -> Maybe CommentTable)
-> Maybe Cursor -> Maybe CommentTable
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Cursor
mCurComments)
  where
    hide :: t Range -> CommentTable -> CommentTable
hide t Range
refs (CommentTable Map Range Comment
m) = Map Range Comment -> CommentTable
CommentTable (Map Range Comment -> CommentTable)
-> Map Range Comment -> CommentTable
forall a b. (a -> b) -> a -> b
$ (Map Range Comment -> Range -> Map Range Comment)
-> Map Range Comment -> t Range -> Map Range Comment
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Range Comment -> Range -> Map Range Comment
forall k. Ord k => Map k Comment -> k -> Map k Comment
hideComment Map Range Comment
m t Range
refs
    hideComment :: Map k Comment -> k -> Map k Comment
hideComment Map k Comment
m k
r = (Comment -> Comment) -> k -> Map k Comment -> Map k Comment
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Comment
c->Comment
c{_commentVisible :: Bool
_commentVisible = Bool
False}) k
r Map k Comment
m
    v :: Text -> Name
v Text
nm = Text -> Maybe Text -> Maybe Text -> Name
Name Text
nm (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"urn:schemas-microsoft-com:vml") Maybe Text
forall a. Maybe a
Nothing
    x :: Text -> Name
x Text
nm = Text -> Maybe Text -> Maybe Text -> Name
Name Text
nm (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"urn:schemas-microsoft-com:office:excel") Maybe Text
forall a. Maybe a
Nothing
    hidden :: Cursor -> [CellRef]
    hidden :: Cursor -> [Range]
hidden Cursor
cur = Cursor
cur Cursor -> (Cursor -> [Range]) -> [Range]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ (Element -> Bool) -> Axis
forall b. Boolean b => (Element -> b) -> Axis
checkElement Element -> Bool
visibleShape Axis -> (Cursor -> [Range]) -> Cursor -> [Range]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/
                 Name -> Axis
element (Text -> Name
xText
"ClientData") Axis -> (Cursor -> [Range]) -> Cursor -> [Range]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Range]
shapeCellRef
    visibleShape :: Element -> Bool
visibleShape Element{[Node]
Map Name Text
Name
elementName :: Element -> Name
elementAttributes :: Element -> Map Name Text
elementNodes :: Element -> [Node]
elementNodes :: [Node]
elementAttributes :: Map Name Text
elementName :: Name
..} = Name
elementName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==  (Text -> Name
vText
"shape") Bool -> Bool -> Bool
&&
        Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
"visibility:hidden"Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Text] -> Bool) -> (Text -> [Text]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';')) (Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"style" Map Name Text
elementAttributes)
    shapeCellRef :: Cursor -> [CellRef]
    shapeCellRef :: Cursor -> [Range]
shapeCellRef Cursor
c = do
        Int
r0 <- Cursor
c Cursor -> (Cursor -> [Int]) -> [Int]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xText
"Row") Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content (Cursor -> [Text]) -> (Text -> [Int]) -> Cursor -> [Int]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Int]
forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
        Int
c0 <- Cursor
c Cursor -> (Cursor -> [Int]) -> [Int]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xText
"Column") Axis -> (Cursor -> [Int]) -> Cursor -> [Int]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content (Cursor -> [Text]) -> (Text -> [Int]) -> Cursor -> [Int]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Int]
forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
        Range -> [Range]
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> [Range]) -> Range -> [Range]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Range
singleCellRef (Int
r0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

getCustomProperties :: Zip.Archive -> Parser CustomProperties
getCustomProperties :: Archive -> Parser CustomProperties
getCustomProperties Archive
ar =
  Archive
-> [Char] -> Text -> CustomProperties -> Parser CustomProperties
forall a.
FromCursor a =>
Archive -> [Char] -> Text -> a -> Parser a
fromFileCursorDef Archive
ar [Char]
"docProps/custom.xml" Text
"custom properties" CustomProperties
CustomProperties.empty

getDrawing :: Zip.Archive -> ContentTypes ->  FilePath -> Parser Drawing
getDrawing :: Archive -> ContentTypes -> [Char] -> Either ParseError Drawing
getDrawing Archive
ar ContentTypes
contentTypes [Char]
fp = do
    Cursor
cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
fp
    Relationships
drawingRels <- Archive -> [Char] -> Parser Relationships
getRels Archive
ar [Char]
fp
    GenericDrawing RefId RefId
unresolved <- ParseError
-> [GenericDrawing RefId RefId]
-> Either ParseError (GenericDrawing RefId RefId)
forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp Text
"Couldn't parse drawing") (Cursor -> [GenericDrawing RefId RefId]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur)
    [Anchor FileInfo ChartSpace]
anchors <- [Anchor RefId RefId]
-> (Anchor RefId RefId
    -> Either ParseError (Anchor FileInfo ChartSpace))
-> Either ParseError [Anchor FileInfo ChartSpace]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (GenericDrawing RefId RefId
unresolved GenericDrawing RefId RefId
-> Getting
     [Anchor RefId RefId]
     (GenericDrawing RefId RefId)
     [Anchor RefId RefId]
-> [Anchor RefId RefId]
forall s a. s -> Getting a s a -> a
^. Getting
  [Anchor RefId RefId]
  (GenericDrawing RefId RefId)
  [Anchor RefId RefId]
forall p g p2 g2.
Iso
  (GenericDrawing p g)
  (GenericDrawing p2 g2)
  [Anchor p g]
  [Anchor p2 g2]
xdrAnchors) ((Anchor RefId RefId
  -> Either ParseError (Anchor FileInfo ChartSpace))
 -> Either ParseError [Anchor FileInfo ChartSpace])
-> (Anchor RefId RefId
    -> Either ParseError (Anchor FileInfo ChartSpace))
-> Either ParseError [Anchor FileInfo ChartSpace]
forall a b. (a -> b) -> a -> b
$ Relationships
-> Anchor RefId RefId
-> Either ParseError (Anchor FileInfo ChartSpace)
resolveFileInfo Relationships
drawingRels
    Drawing -> Either ParseError Drawing
forall (m :: * -> *) a. Monad m => a -> m a
return (Drawing -> Either ParseError Drawing)
-> Drawing -> Either ParseError Drawing
forall a b. (a -> b) -> a -> b
$ [Anchor FileInfo ChartSpace] -> Drawing
forall p g. [Anchor p g] -> GenericDrawing p g
Drawing [Anchor FileInfo ChartSpace]
anchors
  where
    resolveFileInfo :: Relationships -> Anchor RefId RefId -> Parser (Anchor FileInfo ChartSpace)
    resolveFileInfo :: Relationships
-> Anchor RefId RefId
-> Either ParseError (Anchor FileInfo ChartSpace)
resolveFileInfo Relationships
rels Anchor RefId RefId
uAnch =
      case Anchor RefId RefId
uAnch Anchor RefId RefId
-> Getting
     (DrawingObject RefId RefId)
     (Anchor RefId RefId)
     (DrawingObject RefId RefId)
-> DrawingObject RefId RefId
forall s a. s -> Getting a s a -> a
^. Getting
  (DrawingObject RefId RefId)
  (Anchor RefId RefId)
  (DrawingObject RefId RefId)
forall p1 g1 p2 g2.
Lens
  (Anchor p1 g1)
  (Anchor p2 g2)
  (DrawingObject p1 g1)
  (DrawingObject p2 g2)
anchObject of
        Picture {Bool
Maybe Text
ShapeProperties
BlipFillProperties RefId
PicNonVisual
_picShapeProperties :: forall p g. DrawingObject p g -> ShapeProperties
_picBlipFill :: forall p g. DrawingObject p g -> BlipFillProperties p
_picNonVisual :: forall p g. DrawingObject p g -> PicNonVisual
_picPublished :: forall p g. DrawingObject p g -> Bool
_picMacro :: forall p g. DrawingObject p g -> Maybe Text
_picShapeProperties :: ShapeProperties
_picBlipFill :: BlipFillProperties RefId
_picNonVisual :: PicNonVisual
_picPublished :: Bool
_picMacro :: Maybe Text
..} -> do
          let mRefId :: Maybe RefId
mRefId = BlipFillProperties RefId
_picBlipFill BlipFillProperties RefId
-> Getting (Maybe RefId) (BlipFillProperties RefId) (Maybe RefId)
-> Maybe RefId
forall s a. s -> Getting a s a -> a
^. Getting (Maybe RefId) (BlipFillProperties RefId) (Maybe RefId)
forall a1 a2.
Lens
  (BlipFillProperties a1)
  (BlipFillProperties a2)
  (Maybe a1)
  (Maybe a2)
bfpImageInfo
          Maybe FileInfo
mFI <- Relationships -> Maybe RefId -> Either ParseError (Maybe FileInfo)
lookupFI Relationships
rels Maybe RefId
mRefId
          let pic' :: DrawingObject FileInfo g
pic' =
                Picture :: forall p g.
Maybe Text
-> Bool
-> PicNonVisual
-> BlipFillProperties p
-> ShapeProperties
-> DrawingObject p g
Picture
                { _picMacro :: Maybe Text
_picMacro = Maybe Text
_picMacro
                , _picPublished :: Bool
_picPublished = Bool
_picPublished
                , _picNonVisual :: PicNonVisual
_picNonVisual = PicNonVisual
_picNonVisual
                , _picBlipFill :: BlipFillProperties FileInfo
_picBlipFill = (BlipFillProperties RefId
_picBlipFill BlipFillProperties RefId
-> (BlipFillProperties RefId -> BlipFillProperties FileInfo)
-> BlipFillProperties FileInfo
forall a b. a -> (a -> b) -> b
& (Maybe RefId -> Identity (Maybe FileInfo))
-> BlipFillProperties RefId
-> Identity (BlipFillProperties FileInfo)
forall a1 a2.
Lens
  (BlipFillProperties a1)
  (BlipFillProperties a2)
  (Maybe a1)
  (Maybe a2)
bfpImageInfo ((Maybe RefId -> Identity (Maybe FileInfo))
 -> BlipFillProperties RefId
 -> Identity (BlipFillProperties FileInfo))
-> Maybe FileInfo
-> BlipFillProperties RefId
-> BlipFillProperties FileInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe FileInfo
mFI)
                , _picShapeProperties :: ShapeProperties
_picShapeProperties = ShapeProperties
_picShapeProperties
                }
          Anchor FileInfo ChartSpace
-> Either ParseError (Anchor FileInfo ChartSpace)
forall (m :: * -> *) a. Monad m => a -> m a
return Anchor RefId RefId
uAnch {_anchObject :: DrawingObject FileInfo ChartSpace
_anchObject = DrawingObject FileInfo ChartSpace
forall g. DrawingObject FileInfo g
pic'}
        Graphic GraphNonVisual
nv RefId
rId Transform2D
tr -> do
          [Char]
chartPath <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
fp Relationships
rels RefId
rId
          ChartSpace
chart <- Archive -> [Char] -> Parser ChartSpace
readChart Archive
ar [Char]
chartPath
          Anchor FileInfo ChartSpace
-> Either ParseError (Anchor FileInfo ChartSpace)
forall (m :: * -> *) a. Monad m => a -> m a
return Anchor RefId RefId
uAnch {_anchObject :: DrawingObject FileInfo ChartSpace
_anchObject = GraphNonVisual
-> ChartSpace -> Transform2D -> DrawingObject FileInfo ChartSpace
forall p g. GraphNonVisual -> g -> Transform2D -> DrawingObject p g
Graphic GraphNonVisual
nv ChartSpace
chart Transform2D
tr}
    lookupFI :: Relationships -> Maybe RefId -> Either ParseError (Maybe FileInfo)
lookupFI Relationships
_ Maybe RefId
Nothing = Maybe FileInfo -> Either ParseError (Maybe FileInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileInfo
forall a. Maybe a
Nothing
    lookupFI Relationships
rels (Just RefId
rId) = do
      [Char]
path <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
fp Relationships
rels RefId
rId
        -- content types use paths starting with /
      Text
contentType <-
        ParseError -> Maybe Text -> Either ParseError Text
forall a b. a -> Maybe b -> Either a b
note ([Char] -> Text -> ParseError
InvalidFile [Char]
path Text
"Missing content type") (Maybe Text -> Either ParseError Text)
-> Maybe Text -> Either ParseError Text
forall a b. (a -> b) -> a -> b
$
        [Char] -> ContentTypes -> Maybe Text
ContentTypes.lookup ([Char]
"/" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
path) ContentTypes
contentTypes
      ByteString
contents <-
        Entry -> ByteString
Zip.fromEntry (Entry -> ByteString)
-> Either ParseError Entry -> Either ParseError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseError -> Maybe Entry -> Either ParseError Entry
forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
path) ([Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
path Archive
ar)
      Maybe FileInfo -> Either ParseError (Maybe FileInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FileInfo -> Either ParseError (Maybe FileInfo))
-> (FileInfo -> Maybe FileInfo)
-> FileInfo
-> Either ParseError (Maybe FileInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> Maybe FileInfo
forall a. a -> Maybe a
Just (FileInfo -> Either ParseError (Maybe FileInfo))
-> FileInfo -> Either ParseError (Maybe FileInfo)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> ByteString -> FileInfo
FileInfo (ShowS
stripMediaPrefix [Char]
path) Text
contentType ByteString
contents
    stripMediaPrefix :: FilePath -> FilePath
    stripMediaPrefix :: ShowS
stripMediaPrefix [Char]
p = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
p (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"xl/media/" [Char]
p

readChart :: Zip.Archive -> FilePath -> Parser ChartSpace
readChart :: Archive -> [Char] -> Parser ChartSpace
readChart Archive
ar [Char]
path = Archive -> [Char] -> Text -> Parser ChartSpace
forall a. FromCursor a => Archive -> [Char] -> Text -> Parser a
fromFileCursor Archive
ar [Char]
path Text
"chart"

-- | readWorkbook pulls the names of the sheets and the defined names
readWorkbook :: Zip.Archive -> Parser ([WorksheetFile], DefinedNames, Caches, DateBase)
readWorkbook :: Archive -> Parser ([WorksheetFile], DefinedNames, Caches, DateBase)
readWorkbook Archive
ar = do
  let wbPath :: p
wbPath = p
"xl/workbook.xml"
  Cursor
cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
forall p. IsString p => p
wbPath
  Relationships
wbRels <- Archive -> [Char] -> Parser Relationships
getRels Archive
ar [Char]
forall p. IsString p => p
wbPath
  -- Specification says the 'name' is required.
  let mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]
      mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]
mkDefinedName Cursor
c =
        (Text, Maybe Text, Text) -> [(Text, Maybe Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( [Char] -> [Text] -> Text
forall a. HasCallStack => [Char] -> [a] -> a
headNote [Char]
"Missing name attribute" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"name" Cursor
c
          , [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"localSheetId" Cursor
c
          , [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content)
      names :: [(Text, Maybe Text, Text)]
names =
        Cursor
cur Cursor
-> (Cursor -> [(Text, Maybe Text, Text)])
-> [(Text, Maybe Text, Text)]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"definedNames") Axis
-> (Cursor -> [(Text, Maybe Text, Text)])
-> Cursor
-> [(Text, Maybe Text, Text)]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"definedName") Axis
-> (Cursor -> [(Text, Maybe Text, Text)])
-> Cursor
-> [(Text, Maybe Text, Text)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        Cursor -> [(Text, Maybe Text, Text)]
mkDefinedName
  [WorksheetFile]
sheets <-
    [Either ParseError WorksheetFile]
-> Either ParseError [WorksheetFile]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either ParseError WorksheetFile]
 -> Either ParseError [WorksheetFile])
-> [Either ParseError WorksheetFile]
-> Either ParseError [WorksheetFile]
forall a b. (a -> b) -> a -> b
$
    Cursor
cur Cursor
-> (Cursor -> [Either ParseError WorksheetFile])
-> [Either ParseError WorksheetFile]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheets") Axis
-> (Cursor -> [Either ParseError WorksheetFile])
-> Cursor
-> [Either ParseError WorksheetFile]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"sheet") Axis
-> (Cursor -> [Either ParseError WorksheetFile])
-> Cursor
-> [Either ParseError WorksheetFile]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
    (Text -> RefId -> Either ParseError WorksheetFile)
-> [Text] -> [RefId] -> [Either ParseError WorksheetFile]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ([Char]
-> Relationships
-> Text
-> RefId
-> Either ParseError WorksheetFile
worksheetFile [Char]
forall p. IsString p => p
wbPath Relationships
wbRels) ([Text] -> [RefId] -> [Either ParseError WorksheetFile])
-> (Cursor -> [Text])
-> Cursor
-> [RefId]
-> [Either ParseError WorksheetFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Cursor -> [Text]
attribute Name
"name" (Cursor -> [RefId] -> [Either ParseError WorksheetFile])
-> (Cursor -> [RefId])
-> Cursor
-> [Either ParseError WorksheetFile]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Name -> Cursor -> [RefId]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute (Text -> Name
odr Text
"id")
  let cacheRefs :: [(a, b)]
cacheRefs =
        Cursor
cur Cursor -> (Cursor -> [(a, b)]) -> [(a, b)]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"pivotCaches") Axis -> (Cursor -> [(a, b)]) -> Cursor -> [(a, b)]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"pivotCache") Axis -> (Cursor -> [(a, b)]) -> Cursor -> [(a, b)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        (a -> b -> (a, b)) -> [a] -> [b] -> [(a, b)]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ([a] -> [b] -> [(a, b)])
-> (Cursor -> [a]) -> Cursor -> [b] -> [(a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Cursor -> [a]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"cacheId" (Cursor -> [b] -> [(a, b)])
-> (Cursor -> [b]) -> Cursor -> [(a, 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 (Text -> Name
odr Text
"id")
  Caches
caches <-
    [(CacheId, RefId)]
-> ((CacheId, RefId)
    -> Either ParseError (CacheId, (Text, Range, [CacheField])))
-> Either ParseError Caches
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(CacheId, RefId)]
forall a b. (FromAttrVal a, FromAttrVal b) => [(a, b)]
cacheRefs (((CacheId, RefId)
  -> Either ParseError (CacheId, (Text, Range, [CacheField])))
 -> Either ParseError Caches)
-> ((CacheId, RefId)
    -> Either ParseError (CacheId, (Text, Range, [CacheField])))
-> Either ParseError Caches
forall a b. (a -> b) -> a -> b
$ \(CacheId
cacheId, RefId
rId) -> do
      [Char]
path <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
forall p. IsString p => p
wbPath Relationships
wbRels RefId
rId
      ByteString
bs <-
        ParseError -> Maybe ByteString -> Either ParseError ByteString
forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
path) (Maybe ByteString -> Either ParseError ByteString)
-> Maybe ByteString -> Either ParseError ByteString
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry (Entry -> ByteString) -> Maybe Entry -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
path Archive
ar
      (Text
sheet, Range
ref, [CacheField]
fields0, Maybe RefId
mRecRId) <-
        ParseError
-> Maybe (Text, Range, [CacheField], Maybe RefId)
-> Either ParseError (Text, Range, [CacheField], Maybe RefId)
forall a b. a -> Maybe b -> Either a b
note (Text -> ParseError
InconsistentXlsx (Text -> ParseError) -> Text -> ParseError
forall a b. (a -> b) -> a -> b
$ Text
"Bad pivot table cache in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
path) (Maybe (Text, Range, [CacheField], Maybe RefId)
 -> Either ParseError (Text, Range, [CacheField], Maybe RefId))
-> Maybe (Text, Range, [CacheField], Maybe RefId)
-> Either ParseError (Text, Range, [CacheField], Maybe RefId)
forall a b. (a -> b) -> a -> b
$
        ByteString -> Maybe (Text, Range, [CacheField], Maybe RefId)
parseCache ByteString
bs
      [CacheField]
fields <- case Maybe RefId
mRecRId of
        Just RefId
recId -> do
          Relationships
cacheRels <- Archive -> [Char] -> Parser Relationships
getRels Archive
ar [Char]
path
          [Char]
recsPath <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
path Relationships
cacheRels RefId
recId
          Cursor
rCur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
recsPath
          let recs :: [[CacheRecordValue]]
recs = Cursor
rCur Cursor -> (Cursor -> [[CacheRecordValue]]) -> [[CacheRecordValue]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"r") Axis
-> (Cursor -> [[CacheRecordValue]])
-> Cursor
-> [[CacheRecordValue]]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
cur' ->
                [CacheRecordValue] -> [[CacheRecordValue]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CacheRecordValue] -> [[CacheRecordValue]])
-> [CacheRecordValue] -> [[CacheRecordValue]]
forall a b. (a -> b) -> a -> b
$ Cursor
cur' Cursor -> (Cursor -> [CacheRecordValue]) -> [CacheRecordValue]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement Axis
-> (Cursor -> [CacheRecordValue]) -> Cursor -> [CacheRecordValue]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [CacheRecordValue]
recordValueFromNode (Node -> [CacheRecordValue])
-> (Cursor -> Node) -> Cursor -> [CacheRecordValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Node
forall node. Cursor node -> node
node
          [CacheField] -> Either ParseError [CacheField]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CacheField] -> Either ParseError [CacheField])
-> [CacheField] -> Either ParseError [CacheField]
forall a b. (a -> b) -> a -> b
$ [CacheField] -> [[CacheRecordValue]] -> [CacheField]
fillCacheFieldsFromRecords [CacheField]
fields0 [[CacheRecordValue]]
recs
        Maybe RefId
Nothing ->
          [CacheField] -> Either ParseError [CacheField]
forall (m :: * -> *) a. Monad m => a -> m a
return [CacheField]
fields0
      (CacheId, (Text, Range, [CacheField]))
-> Either ParseError (CacheId, (Text, Range, [CacheField]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((CacheId, (Text, Range, [CacheField]))
 -> Either ParseError (CacheId, (Text, Range, [CacheField])))
-> (CacheId, (Text, Range, [CacheField]))
-> Either ParseError (CacheId, (Text, Range, [CacheField]))
forall a b. (a -> b) -> a -> b
$ (CacheId
cacheId, (Text
sheet, Range
ref, [CacheField]
fields))
  let dateBase :: DateBase
dateBase = DateBase -> DateBase -> Bool -> DateBase
forall a. a -> a -> Bool -> a
bool DateBase
DateBase1900 DateBase
DateBase1904 (Bool -> DateBase) -> ([Bool] -> Bool) -> [Bool] -> DateBase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> ([Bool] -> Maybe Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Maybe Bool
forall a. [a] -> Maybe a
listToMaybe ([Bool] -> DateBase) -> [Bool] -> DateBase
forall a b. (a -> b) -> a -> b
$
                 Cursor
cur Cursor -> (Cursor -> [Bool]) -> [Bool]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"workbookPr") Axis -> (Cursor -> [Bool]) -> Cursor -> [Bool]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Bool]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"date1904"
  ([WorksheetFile], DefinedNames, Caches, DateBase)
-> Parser ([WorksheetFile], DefinedNames, Caches, DateBase)
forall (m :: * -> *) a. Monad m => a -> m a
return ([WorksheetFile]
sheets, [(Text, Maybe Text, Text)] -> DefinedNames
DefinedNames [(Text, Maybe Text, Text)]
names, Caches
caches, DateBase
dateBase)

getTable :: Zip.Archive -> FilePath -> Parser Table
getTable :: Archive -> [Char] -> Either ParseError Table
getTable Archive
ar [Char]
fp = do
  Cursor
cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
fp
  ParseError -> [Table] -> Either ParseError Table
forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp Text
"Couldn't parse drawing") (Cursor -> [Table]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur)

worksheetFile :: FilePath -> Relationships -> Text -> RefId -> Parser WorksheetFile
worksheetFile :: [Char]
-> Relationships
-> Text
-> RefId
-> Either ParseError WorksheetFile
worksheetFile [Char]
parentPath Relationships
wbRels Text
name RefId
rId =
  Text -> [Char] -> WorksheetFile
WorksheetFile Text
name ([Char] -> WorksheetFile)
-> Either ParseError [Char] -> Either ParseError WorksheetFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
parentPath Relationships
wbRels RefId
rId

getRels :: Zip.Archive -> FilePath -> Parser Relationships
getRels :: Archive -> [Char] -> Parser Relationships
getRels Archive
ar [Char]
fp = do
    let ([Char]
dir, [Char]
file) = [Char] -> ([Char], [Char])
splitFileName [Char]
fp
        relsPath :: [Char]
relsPath = [Char]
dir [Char] -> ShowS
</> [Char]
"_rels" [Char] -> ShowS
</> [Char]
file [Char] -> ShowS
<.> [Char]
"rels"
    Maybe Cursor
c <- Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
ar [Char]
relsPath
    Relationships -> Parser Relationships
forall (m :: * -> *) a. Monad m => a -> m a
return (Relationships -> Parser Relationships)
-> Relationships -> Parser Relationships
forall a b. (a -> b) -> a -> b
$ Relationships
-> (Cursor -> Relationships) -> Maybe Cursor -> Relationships
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Relationships
Relationships.empty ([Char] -> Relationships -> Relationships
setTargetsFrom [Char]
fp (Relationships -> Relationships)
-> (Cursor -> Relationships) -> Cursor -> Relationships
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Relationships] -> Relationships
forall a. HasCallStack => [Char] -> [a] -> a
headNote [Char]
"Missing rels" ([Relationships] -> Relationships)
-> (Cursor -> [Relationships]) -> Cursor -> Relationships
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [Relationships]
forall a. FromCursor a => Cursor -> [a]
fromCursor) Maybe Cursor
c

lookupRelPath :: FilePath
              -> Relationships
              -> RefId
              -> Either ParseError FilePath
lookupRelPath :: [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
fp Relationships
rels RefId
rId =
  Relationship -> [Char]
relTarget (Relationship -> [Char])
-> Either ParseError Relationship -> Either ParseError [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseError -> Maybe Relationship -> Either ParseError Relationship
forall a b. a -> Maybe b -> Either a b
note ([Char] -> RefId -> ParseError
InvalidRef [Char]
fp RefId
rId) (RefId -> Relationships -> Maybe Relationship
Relationships.lookup RefId
rId Relationships
rels)