{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE PackageImports #-}
{-# 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 "zip-archive" 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 (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.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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Partial => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser Xlsx
toXlsxEither

data ParseError = InvalidZipArchive String
                | MissingFile FilePath
                | InvalidFile FilePath Text
                | InvalidRef FilePath RefId
                | InconsistentXlsx Text
                deriving (ParseError -> ParseError -> Bool
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]
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. 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Partial => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser Xlsx
toXlsxEitherFast

-- | Reads `Xlsx' from raw data (lazy bytestring), failing with 'Left' on parse error
toXlsxEither :: L.ByteString -> Parser Xlsx
toXlsxEither :: ByteString -> Parser Xlsx
toXlsxEither = (Archive
 -> SharedStringTable
 -> ContentTypes
 -> Caches
 -> WorksheetFile
 -> Parser Worksheet)
-> ByteString -> Parser 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 -> Parser Xlsx
toXlsxEitherFast = (Archive
 -> SharedStringTable
 -> ContentTypes
 -> Caches
 -> WorksheetFile
 -> Parser Worksheet)
-> ByteString -> Parser 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 -> Parser Xlsx
toXlsxEitherBase Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
parseSheet ByteString
bs = do
  Archive
ar <- forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left [Char] -> ParseError
InvalidZipArchive 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [WorksheetFile]
wfs 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
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorksheetFile -> Text
wfName WorksheetFile
wf,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' Worksheet SheetState
wsState forall s t a b. ASetter s t a b -> b -> s -> t
.~ WorksheetFile -> SheetState
wfState WorksheetFile
wf) forall a b. (a -> b) -> a -> b
$ Worksheet
sheet
  CustomProperties Map Text Variant
customPropMap <- Archive -> Parser CustomProperties
getCustomProperties Archive
ar
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> SheetState
wfState :: SheetState
                                   , WorksheetFile -> [Char]
wfPath :: FilePath
                                   }
                   deriving (Int -> WorksheetFile -> ShowS
[WorksheetFile] -> ShowS
WorksheetFile -> [Char]
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. 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 <-
    forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
filePath) forall a b. (a -> b) -> a -> b
$
    Entry -> ByteString
Zip.fromEntry 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 <-
    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 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show XenoException
ex)) 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 :: a
odrNs =
            a
"http://schemas.openxmlformats.org/officeDocument/2006/relationships"
          odrX :: ByteString -> ByteString
odrX = NsPrefixes -> ByteString -> ByteString -> ByteString
addPrefix NsPrefixes
prefixes forall {a}. IsString a => a
odrNs
          skip :: ByteString -> ChildCollector ()
skip = forall (f :: * -> *) a. Functor f => f a -> f ()
void 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) <-
        forall a. Either Text a -> Parser a
liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root forall a b. (a -> b) -> a -> b
$ do
          ByteString -> ChildCollector ()
skip ByteString
"sheetPr"
          ByteString -> ChildCollector ()
skip ByteString
"dimension"
          Maybe [SheetView]
_wsSheetViews <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Maybe [a] -> Maybe [a]
justNonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"sheetViews" forall a b. (a -> b) -> a -> b
$ \Node
n ->
            forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n forall a b. (a -> b) -> a -> b
$ forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"sheetView"
          ByteString -> ChildCollector ()
skip ByteString
"sheetFormatPr"
          [ColumnsProperties]
_wsColumnsProperties <-
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"cols" forall a b. (a -> b) -> a -> b
$ \Node
n ->
              forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"col")
          (Map RowIndex RowProperties
_wsRowPropertiesMap, CellMap
_wsCells, Map SharedFormulaIndex SharedFormulaOptions
_wsSharedFormulas) <-
            forall a. ByteString -> (Node -> Either Text a) -> ChildCollector a
requireAndParse ByteString
"sheetData" forall a b. (a -> b) -> a -> b
$ \Node
n -> do
              [Node]
rows <- forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"row"
              forall {t :: * -> *}.
Foldable t =>
t (RowIndex, Maybe RowProperties,
   [(RowIndex, ColumnIndex, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRows forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
rows Node
-> Either
     Text
     (RowIndex, Maybe RowProperties,
      [(RowIndex, ColumnIndex, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
parseRow
          ByteString -> ChildCollector ()
skip ByteString
"sheetCalcPr"
          Maybe SheetProtection
_wsProtection <- forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
maybeFromChild ByteString
"sheetProtection"
          ByteString -> ChildCollector ()
skip ByteString
"protectedRanges"
          ByteString -> ChildCollector ()
skip ByteString
"scenarios"
          Maybe AutoFilter
_wsAutoFilter <- 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"mergeCells" forall a b. (a -> b) -> a -> b
$ \Node
n -> do
            [Node]
mCells <- forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"mergeCell"
            forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
mCells forall a b. (a -> b) -> a -> b
$ \Node
mCell -> forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
mCell forall a b. (a -> b) -> a -> b
$ forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"ref"
          Map SqRef ConditionalFormatting
_wsConditionalFormattings <-
            forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map CfPair -> (SqRef, ConditionalFormatting)
unCfPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromXenoNode a => ByteString -> ChildCollector [a]
fromChildList ByteString
"conditionalFormatting"
          Map SqRef DataValidation
_wsDataValidations <-
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"dataValidations" forall a b. (a -> b) -> a -> b
$ \Node
n -> do
              forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map DvPair -> (SqRef, DataValidation)
unDvPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n (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 <- 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 <- forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"drawing" forall a b. (a -> b) -> a -> b
$ \Node
n ->
            forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
n forall a b. (a -> b) -> a -> b
$ forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr (ByteString -> ByteString
odrX ByteString
"id")
          Maybe RefId
legacyDrRId <- forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"legacyDrawing" forall a b. (a -> b) -> a -> b
$ \Node
n ->
            forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
n forall a b. (a -> b) -> a -> b
$ forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr (ByteString -> ByteString
odrX ByteString
"id")
          [RefId]
tableIds <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ByteString -> (Node -> Either Text a) -> ChildCollector (Maybe a)
maybeParse ByteString
"tableParts" forall a b. (a -> b) -> a -> b
$ \Node
n -> do
            [Node]
tParts <- forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
n forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"tablePart"
            forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
tParts forall a b. (a -> b) -> a -> b
$ \Node
part ->
              forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
part forall a b. (a -> b) -> a -> b
$ forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr (ByteString -> ByteString
odrX ByteString
"id")

          -- all explicitly assigned fields filled below
          forall (m :: * -> *) a. Monad m => a -> m a
return (
            Worksheet
            { _wsDrawing :: Maybe Drawing
_wsDrawing = forall a. Maybe a
Nothing
            , _wsPivotTables :: [PivotTable]
_wsPivotTables = []
            , _wsTables :: [Table]
_wsTables = []
            , _wsState :: SheetState
_wsState = WorksheetFile -> SheetState
wfState WorksheetFile
wf
            , [Range]
[ColumnsProperties]
Maybe [SheetView]
Maybe SheetProtection
Maybe PageSetup
Maybe AutoFilter
CellMap
Map SqRef ConditionalFormatting
Map SqRef DataValidation
Map RowIndex RowProperties
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 RowIndex 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 RowIndex RowProperties
_wsColumnsProperties :: [ColumnsProperties]
_wsSheetViews :: Maybe [SheetView]
..
            }
            , [RefId]
tableIds
            , Maybe RefId
drawingRId
            , Maybe RefId
legacyDrRId)

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

      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Worksheet
ws forall a b. a -> (a -> b) -> b
& Lens' Worksheet [Table]
wsTables forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Table]
tables
                  forall a b. a -> (a -> b) -> b
& Lens' Worksheet CellMap
wsCells forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ CellMap -> CellMap
mergeComments
                  forall a b. a -> (a -> b) -> b
& Lens' Worksheet (Maybe Drawing)
wsDrawing forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Drawing
drawing
                  forall a b. a -> (a -> b) -> b
& Lens' Worksheet [PivotTable]
wsPivotTables forall s t a b. ASetter s t a b -> b -> s -> t
.~ [PivotTable]
pivotTables
    liftEither :: Either Text a -> Parser a
    liftEither :: forall a. Either Text a -> Parser a
liftEither = 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]
_ = forall a. Maybe a
Nothing
    collectRows :: t (RowIndex, Maybe RowProperties,
   [(RowIndex, ColumnIndex, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRows = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RowIndex, Maybe RowProperties,
 [(RowIndex, ColumnIndex, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (forall k a. Map k a
M.empty, forall k a. Map k a
M.empty, forall k a. Map k a
M.empty)
    collectRow ::
         ( RowIndex
         , Maybe RowProperties
         , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])
      -> ( Map RowIndex RowProperties
         , CellMap
         , Map SharedFormulaIndex SharedFormulaOptions)
      -> ( Map RowIndex RowProperties
         , CellMap
         , Map SharedFormulaIndex SharedFormulaOptions)
    collectRow :: (RowIndex, Maybe RowProperties,
 [(RowIndex, ColumnIndex, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (RowIndex
r, Maybe RowProperties
mRP, [(RowIndex, ColumnIndex, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells) (Map RowIndex RowProperties
rowMap, CellMap
cellMap, Map SharedFormulaIndex SharedFormulaOptions
sharedF) =
      let ([((RowIndex, ColumnIndex), Cell)]
newCells0, [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0) =
            forall a b. [(a, b)] -> ([a], [b])
unzip [(((RowIndex
rInd, ColumnIndex
cInd), Cell
cd), Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) | (RowIndex
rInd, ColumnIndex
cInd, Cell
cd, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) <- [(RowIndex, ColumnIndex, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells]
          newCells :: CellMap
newCells = forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [((RowIndex, ColumnIndex), Cell)]
newCells0
          newSharedF :: Map SharedFormulaIndex SharedFormulaOptions
newSharedF = forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0
          newRowMap :: Map RowIndex RowProperties
newRowMap =
            case Maybe RowProperties
mRP of
              Just RowProperties
rp -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert RowIndex
r RowProperties
rp Map RowIndex RowProperties
rowMap
              Maybe RowProperties
Nothing -> Map RowIndex RowProperties
rowMap
      in (Map RowIndex RowProperties
newRowMap, CellMap
cellMap forall a. Semigroup a => a -> a -> a
<> CellMap
newCells, Map SharedFormulaIndex SharedFormulaOptions
sharedF forall a. Semigroup a => a -> a -> a
<> Map SharedFormulaIndex SharedFormulaOptions
newSharedF)
    parseRow ::
         Xeno.Node
      -> Either Text ( RowIndex
                     , Maybe RowProperties
                     , [( RowIndex
                        , ColumnIndex
                        , Cell
                        , Maybe (SharedFormulaIndex, SharedFormulaOptions))])
    parseRow :: Node
-> Either
     Text
     (RowIndex, Maybe RowProperties,
      [(RowIndex, ColumnIndex, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
parseRow Node
row = do
      (Int
r, Maybe Int
s, Maybe Double
ht, Bool
cstHt, Bool
hidden) <-
        forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
row forall a b. (a -> b) -> a -> b
$
        ((,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"r" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"s" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"ht" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"customHeight" Bool
False forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
         forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"hidden" Bool
False)
      let props :: RowProperties
props =
            RowProps
            { rowHeight :: Maybe RowHeight
rowHeight =
                if Bool
cstHt
                  then Double -> RowHeight
CustomHeight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
ht
                  else Double -> RowHeight
AutomaticHeight 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 <- forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
row forall a b. (a -> b) -> a -> b
$ ByteString -> ChildCollector [Node]
childList ByteString
"c"
      [(RowIndex, ColumnIndex, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
cells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Node]
cellNodes Node
-> Either
     Text
     (RowIndex, ColumnIndex, Cell,
      Maybe (SharedFormulaIndex, SharedFormulaOptions))
parseCell
      forall (m :: * -> *) a. Monad m => a -> m a
return
        ( Int -> RowIndex
RowIndex Int
r
        , if RowProperties
props forall a. Eq a => a -> a -> Bool
== forall a. Default a => a
def
            then forall a. Maybe a
Nothing
            else forall a. a -> Maybe a
Just RowProperties
props
        , [(RowIndex, ColumnIndex, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
cells)

    -- NB: According to format specification default value for cells without
    -- `t` attribute is a `n` - number.
    --
    -- Schema part from spec (see the `CellValue` spec reference):
    -- <xsd:complexType name="CT_Cell">
    --  ..
    --  <xsd:attribute name="t" type="ST_CellType" use="optional" default="n"/>
    -- </xsd:complexType>
    parseCell ::
         Xeno.Node
      -> Either Text ( RowIndex
                     , ColumnIndex
                     , Cell
                     , Maybe (SharedFormulaIndex, SharedFormulaOptions))
    parseCell :: Node
-> Either
     Text
     (RowIndex, ColumnIndex, Cell,
      Maybe (SharedFormulaIndex, SharedFormulaOptions))
parseCell Node
cell = do
      (Range
ref, Maybe Int
s, ByteString
t) <-
        forall a. Node -> AttrParser a -> Either Text a
parseAttributes Node
cell forall a b. (a -> b) -> a -> b
$
        (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrBs a => ByteString -> AttrParser a
fromAttr ByteString
"r" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromAttrBs a => ByteString -> AttrParser (Maybe a)
maybeAttr ByteString
"s" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromAttrBs a => ByteString -> a -> AttrParser a
fromAttrDef ByteString
"t" ByteString
"n"
      (Maybe Node
fNode, Maybe Node
vNode, Maybe Node
isNode) <-
        forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
cell forall a b. (a -> b) -> a -> b
$
        (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ChildCollector (Maybe Node)
maybeChild ByteString
"f" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ChildCollector (Maybe Node)
maybeChild ByteString
"v" 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 :: forall a. FromAttrBs a => Either Text (Maybe a)
vConverted =
            case Node -> ByteString
contentBs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Node
vNode of
              Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              Just ByteString
c -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrBs a => ByteString -> Either Text a
fromAttrBs ByteString
c
      Maybe FormulaData
mFormulaData <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 <- forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
            case SharedStringTable -> Int -> Maybe XlsxText
sstItem SharedStringTable
sst forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
si of
              Just XlsxText
xlTxt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (XlsxText -> CellValue
xlsxTextToCellValue XlsxText
xlTxt)
              Maybe XlsxText
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"bad shared string index"
          ByteString
"inlineStr" -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XlsxText -> CellValue
xlsxTextToCellValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromXenoNode a => Node -> Either Text a
fromXenoNode) Maybe Node
isNode
          ByteString
"str" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> CellValue
CellText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
"n" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> CellValue
CellDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
"b" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> CellValue
CellBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
"e" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorType -> CellValue
CellError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
          ByteString
unexpected ->
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text
"unexpected cell type " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ByteString
unexpected)
      let (RowIndex
r, ColumnIndex
c) = Range -> (RowIndex, ColumnIndex)
fromSingleCellRefNoting Range
ref
          f :: Maybe CellFormula
f = FormulaData -> CellFormula
frmdFormula 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe FormulaData
mFormulaData
      forall (m :: * -> *) a. Monad m => a -> m a
return (RowIndex
r, ColumnIndex
c, Maybe Int
-> Maybe CellValue -> Maybe Comment -> Maybe CellFormula -> Cell
Cell Maybe Int
s Maybe CellValue
d 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 <- forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
filePath) forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
filePath Archive
ar
  Cursor
cur <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Document -> Cursor
fromDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show SomeException
ex)) forall a b. (a -> b) -> a -> b
$
         ParseSettings -> ByteString -> Either SomeException Document
parseLBS 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheetViews") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"sheetView") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor
       sheetViews :: Maybe [a]
sheetViews = case forall {a}. FromCursor a => [a]
sheetViewList of
         []    -> forall a. Maybe a
Nothing
         [a]
views -> forall a. a -> Maybe a
Just [a]
views

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

  Maybe CommentTable
commentsMap :: Maybe CommentTable <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right 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 = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"pageSetup") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor

      cws :: [a]
cws = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"cols") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"col") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor

      (Map RowIndex RowProperties
rowProps, CellMap
cells0, Map SharedFormulaIndex SharedFormulaOptions
sharedFormulas) =
        forall {t :: * -> *}.
Foldable t =>
t (RowIndex, Maybe RowProperties,
   [(RowIndex, ColumnIndex, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collect forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheetData") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"row") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor
-> [(RowIndex, Maybe RowProperties,
     [(RowIndex, ColumnIndex, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
parseRow
      parseRow ::
           Cursor
        -> [( RowIndex
            , Maybe RowProperties
            , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
      parseRow :: Cursor
-> [(RowIndex, Maybe RowProperties,
     [(RowIndex, ColumnIndex, Cell,
       Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
parseRow Cursor
c = do
        RowIndex
r <- Int -> RowIndex
RowIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"r" Cursor
c
        let prop :: RowProperties
prop = RowProps
              { rowHeight :: Maybe RowHeight
rowHeight = do Double
h <- forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"ht" Cursor
c
                               case forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"customHeight" Cursor
c of
                                 [Bool
True] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> RowHeight
CustomHeight    Double
h
                                 [Bool]
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> RowHeight
AutomaticHeight Double
h
              , rowStyle :: Maybe Int
rowStyle  = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"s" Cursor
c
              , rowHidden :: Bool
rowHidden =
                  case forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"hidden" Cursor
c of
                    []  -> Bool
False
                    Bool
f:[Bool]
_ -> Bool
f
              }
        forall (m :: * -> *) a. Monad m => a -> m a
return ( RowIndex
r
               , if RowProperties
prop forall a. Eq a => a -> a -> Bool
== forall a. Default a => a
def then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just RowProperties
prop
               , Cursor
c forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"c") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor
-> [(RowIndex, ColumnIndex, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
parseCell
               )
      parseCell ::
           Cursor
        -> [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
      parseCell :: Cursor
-> [(RowIndex, ColumnIndex, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))]
parseCell Cursor
cell = do
        Range
ref <- forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"r" Cursor
cell
        let s :: Maybe a
s = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cell forall node a. Cursor node -> (Cursor node -> a) -> a
$| Name -> Cursor -> [Text]
attribute Name
"s" forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
            -- NB: According to format specification default value for cells without
            -- `t` attribute is a `n` - number.
            --
            -- <xsd:complexType name="CT_Cell" from spec (see the `CellValue` spec reference)>
            --  ..
            --  <xsd:attribute name="t" type="ST_CellType" use="optional" default="n"/>
            -- </xsd:complexType>
            t :: Text
t = forall a. a -> Maybe a -> a
fromMaybe Text
"n" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cell forall node a. Cursor node -> (Cursor node -> a) -> a
$| Name -> Cursor -> [Text]
attribute Name
"t"
            d :: Maybe CellValue
d = forall a. [a] -> Maybe a
listToMaybe 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 = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cell forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"f") 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 = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
mFormulaData
            shared :: Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared = forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe
  (CellFormula, Maybe (SharedFormulaIndex, SharedFormulaOptions))
mFormulaData
            (RowIndex
r, ColumnIndex
c) = Range -> (RowIndex, ColumnIndex)
fromSingleCellRefNoting Range
ref
            comment :: Maybe Comment
comment = Maybe CommentTable
commentsMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Range -> CommentTable -> Maybe Comment
lookupComment Range
ref
        forall (m :: * -> *) a. Monad m => a -> m a
return (RowIndex
r, ColumnIndex
c, Maybe Int
-> Maybe CellValue -> Maybe Comment -> Maybe CellFormula -> Cell
Cell forall {a}. Integral a => Maybe a
s Maybe CellValue
d Maybe Comment
comment Maybe CellFormula
f, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared)
      collect :: t (RowIndex, Maybe RowProperties,
   [(RowIndex, ColumnIndex, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collect = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RowIndex, Maybe RowProperties,
 [(RowIndex, ColumnIndex, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (forall k a. Map k a
M.empty, forall k a. Map k a
M.empty, forall k a. Map k a
M.empty)
      collectRow ::
           ( RowIndex
           , Maybe RowProperties
           , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])
        -> (Map RowIndex RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)
        -> (Map RowIndex RowProperties, CellMap, Map SharedFormulaIndex SharedFormulaOptions)
      collectRow :: (RowIndex, Maybe RowProperties,
 [(RowIndex, ColumnIndex, Cell,
   Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRow (RowIndex
r, Maybe RowProperties
mRP, [(RowIndex, ColumnIndex, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells) (Map RowIndex RowProperties
rowMap, CellMap
cellMap, Map SharedFormulaIndex SharedFormulaOptions
sharedF) =
        let ([((RowIndex, ColumnIndex), Cell)]
newCells0, [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0) =
              forall a b. [(a, b)] -> ([a], [b])
unzip [(((RowIndex
x,ColumnIndex
y),Cell
cd), Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) | (RowIndex
x, ColumnIndex
y, Cell
cd, Maybe (SharedFormulaIndex, SharedFormulaOptions)
shared) <- [(RowIndex, ColumnIndex, Cell,
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
rowCells]
            newCells :: CellMap
newCells = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((RowIndex, ColumnIndex), Cell)]
newCells0
            newSharedF :: Map SharedFormulaIndex SharedFormulaOptions
newSharedF = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe (SharedFormulaIndex, SharedFormulaOptions)]
newSharedF0
            newRowMap :: Map RowIndex RowProperties
newRowMap = case Maybe RowProperties
mRP of
              Just RowProperties
rp -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert RowIndex
r RowProperties
rp Map RowIndex RowProperties
rowMap
              Maybe RowProperties
Nothing -> Map RowIndex RowProperties
rowMap
        in (Map RowIndex RowProperties
newRowMap, CellMap
cellMap forall a. Semigroup a => a -> a -> a
<> CellMap
newCells, Map SharedFormulaIndex SharedFormulaOptions
sharedF forall a. Semigroup a => a -> a -> a
<> Map SharedFormulaIndex SharedFormulaOptions
newSharedF)

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

      mProtection :: Maybe a
mProtection = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheetProtection") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor

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

      merges :: [Range]
merges = Cursor
cur 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") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"mergeCell") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"ref"

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

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

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

  let mAutoFilter :: Maybe a
mAutoFilter = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"autoFilter") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromCursor a => Cursor -> [a]
fromCursor

  Maybe Drawing
mDrawing <- case forall {a}. FromAttrVal a => Maybe a
mDrawingId of
      Just RefId
dId -> do
          Relationship
rel <- forall a b. a -> Maybe b -> Either a b
note ([Char] -> RefId -> ParseError
InvalidRef [Char]
filePath RefId
dId) forall a b. (a -> b) -> a -> b
$ RefId -> Relationships -> Maybe Relationship
Relationships.lookup RefId
dId Relationships
sheetRels
          forall a. a -> Maybe a
Just 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  ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

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

  [Table]
tables <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM forall {a}. FromAttrVal a => [a]
tableIds 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

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

extractCellValue :: SharedStringTable -> Text -> Cursor -> [CellValue]
extractCellValue :: SharedStringTable -> Text -> Cursor -> [CellValue]
extractCellValue SharedStringTable
sst Text
t Cursor
cur
  | Text
t forall a. Eq a => a -> a -> Bool
== Text
"s" = do
    Int
si <- forall {b}. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"shared string"
    case SharedStringTable -> Int -> Maybe XlsxText
sstItem SharedStringTable
sst Int
si of
      Just XlsxText
xlTxt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ XlsxText -> CellValue
xlsxTextToCellValue XlsxText
xlTxt
      Maybe XlsxText
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"bad shared string index"
  | Text
t forall a. Eq a => a -> a -> Bool
== Text
"inlineStr" =
    Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"is") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XlsxText -> CellValue
xlsxTextToCellValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromCursor a => Cursor -> [a]
fromCursor
  | Text
t forall a. Eq a => a -> a -> Bool
== Text
"str" = Text -> CellValue
CellText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"string"
  | Text
t forall a. Eq a => a -> a -> Bool
== Text
"n" = Double -> CellValue
CellDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"double"
  | Text
t forall a. Eq a => a -> a -> Bool
== Text
"b" = Bool -> CellValue
CellBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"boolean"
  | Text
t forall a. Eq a => a -> a -> Bool
== Text
"e" = ErrorType -> CellValue
CellError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b}. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"error"
  | Bool
otherwise = 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"v") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
c ->
        forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Cursor
c forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content)
      case forall a. FromAttrVal a => Reader a
fromAttrVal Text
vContent of
        Right (b
val, Text
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b
val
        Either [Char] (b, Text)
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"bad " forall a. [a] -> [a] -> [a]
++ [Char]
typeStr 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 =
    (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
fname) forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` forall a. ParseError -> Either ParseError (Maybe a)
missingToNothing
  where
    missingToNothing :: ParseError -> Either ParseError (Maybe a)
    missingToNothing :: forall a. ParseError -> Either ParseError (Maybe a)
missingToNothing (MissingFile [Char]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    missingToNothing ParseError
other           = 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 <- forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
fname) forall a b. (a -> b) -> a -> b
$ [Char] -> Archive -> Maybe Entry
Zip.findEntryByPath [Char]
fname Archive
ar
    Document
cur <- 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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show SomeException
ex)) forall a b. (a -> b) -> a -> b
$ ParseSettings -> ByteString -> Either SomeException Document
parseLBS forall a. Default a => a
def (Entry -> ByteString
Zip.fromEntry Entry
entry)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Document -> Cursor
fromDocument Document
cur

fromFileCursorDef ::
     FromCursor a => Zip.Archive -> FilePath -> Text -> a -> Parser a
fromFileCursorDef :: forall a.
FromCursor a =>
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 ->
      forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp forall a b. (a -> b) -> a -> b
$ Text
"Couldn't parse " forall a. Semigroup a => a -> a -> a
<> Text
contentsDescr) forall a b. (a -> b) -> a -> b
$ forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    Maybe Cursor
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return a
defVal

fromFileCursor :: FromCursor a => Zip.Archive -> FilePath -> Text -> Parser a
fromFileCursor :: forall a. FromCursor a => 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
  forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp forall a b. (a -> b) -> a -> b
$ Text
"Couldn't parse " forall a. Semigroup a => a -> a -> a
<> Text
contentsDescr) forall a b. (a -> b) -> a -> b
$ 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 =
  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 = 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 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
ar) Maybe [Char]
drp
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall {t :: * -> *}.
Foldable t =>
t Range -> CommentTable -> CommentTable
hide (Cursor -> [Range]
hidden forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Cursor
mCurDr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromCursor a => Cursor -> [a]
fromCursor 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 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 = 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 (forall a. a -> Maybe a
Just Text
"urn:schemas-microsoft-com:vml") forall a. Maybe a
Nothing
    x :: Text -> Name
x Text
nm = Text -> Maybe Text -> Maybe Text -> Name
Name Text
nm (forall a. a -> Maybe a
Just Text
"urn:schemas-microsoft-com:office:excel") forall a. Maybe a
Nothing
    hidden :: Cursor -> [CellRef]
    hidden :: Cursor -> [Range]
hidden Cursor
cur = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ forall b. Boolean b => (Element -> b) -> Axis
checkElement Element -> Bool
visibleShape forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/
                 Name -> Axis
element (Text -> Name
xText
"ClientData") 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 forall a. Eq a => a -> a -> Bool
==  (Text -> Name
vText
"shape") Bool -> Bool -> Bool
&&
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
"visibility:hidden"forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
==Char
';')) (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
        RowIndex
r0 <- Cursor
c forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xText
"Row") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
        ColumnIndex
c0 <- Cursor
c forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xText
"Column") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (RowIndex, ColumnIndex) -> Range
singleCellRef (RowIndex
r0 forall a. Num a => a -> a -> a
+ RowIndex
1, ColumnIndex
c0 forall a. Num a => a -> a -> a
+ ColumnIndex
1)

getCustomProperties :: Zip.Archive -> Parser CustomProperties
getCustomProperties :: Archive -> Parser CustomProperties
getCustomProperties Archive
ar =
  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 <- forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp Text
"Couldn't parse drawing") (forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur)
    [Anchor FileInfo ChartSpace]
anchors <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (GenericDrawing RefId RefId
unresolved forall s a. s -> Getting a s a -> a
^. forall p1 g1 p2 g2.
Iso
  (GenericDrawing p1 g1)
  (GenericDrawing p2 g2)
  [Anchor p1 g1]
  [Anchor p2 g2]
xdrAnchors) forall a b. (a -> b) -> a -> b
$ Relationships
-> Anchor RefId RefId -> Parser (Anchor FileInfo ChartSpace)
resolveFileInfo Relationships
drawingRels
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> Parser (Anchor FileInfo ChartSpace)
resolveFileInfo Relationships
rels Anchor RefId RefId
uAnch =
      case Anchor RefId RefId
uAnch forall s a. s -> Getting a s a -> a
^. 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 forall s a. s -> Getting a s a -> a
^. 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
                { _picMacro :: Maybe Text
_picMacro = Maybe Text
_picMacro
                , _picPublished :: Bool
_picPublished = Bool
_picPublished
                , _picNonVisual :: PicNonVisual
_picNonVisual = PicNonVisual
_picNonVisual
                , _picBlipFill :: BlipFillProperties FileInfo
_picBlipFill = (BlipFillProperties RefId
_picBlipFill forall a b. a -> (a -> b) -> b
& forall a1 a2.
Lens
  (BlipFillProperties a1)
  (BlipFillProperties a2)
  (Maybe a1)
  (Maybe a2)
bfpImageInfo forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe FileInfo
mFI)
                , _picShapeProperties :: ShapeProperties
_picShapeProperties = ShapeProperties
_picShapeProperties
                }
          forall (m :: * -> *) a. Monad m => a -> m a
return Anchor RefId RefId
uAnch {_anchObject :: DrawingObject FileInfo ChartSpace
_anchObject = 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
          forall (m :: * -> *) a. Monad m => a -> m a
return Anchor RefId RefId
uAnch {_anchObject :: DrawingObject FileInfo ChartSpace
_anchObject = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return 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 <-
        forall a b. a -> Maybe b -> Either a b
note ([Char] -> Text -> ParseError
InvalidFile [Char]
path Text
"Missing content type") forall a b. (a -> b) -> a -> b
$
        [Char] -> ContentTypes -> Maybe Text
ContentTypes.lookup ([Char]
"/" forall a. Semigroup a => a -> a -> a
<> [Char]
path) ContentTypes
contentTypes
      ByteString
contents <-
        Entry -> ByteString
Zip.fromEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just 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 = forall a. a -> Maybe a -> a
fromMaybe [Char]
p forall a b. (a -> b) -> a -> b
$ 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 = 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 :: a
wbPath = a
"xl/workbook.xml"
  Cursor
cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar forall {a}. IsString a => a
wbPath
  Relationships
wbRels <- Archive -> [Char] -> Parser Relationships
getRels Archive
ar forall {a}. IsString a => a
wbPath
  -- Specification says the 'name' is required.
  let mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]
      mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]
mkDefinedName Cursor
c =
        forall (m :: * -> *) a. Monad m => a -> m a
return
          ( forall a. Partial => [Char] -> [a] -> a
headNote [Char]
"Missing name attribute" forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"name" Cursor
c
          , forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"localSheetId" Cursor
c
          , [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Cursor
c forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content)
      names :: [(Text, Maybe Text, Text)]
names =
        Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"definedNames") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"definedName") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        Cursor -> [(Text, Maybe Text, Text)]
mkDefinedName
  [WorksheetFile]
sheets <-
    forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
    Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"sheets") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"sheet") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
    forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 ([Char]
-> Relationships
-> Text
-> SheetState
-> RefId
-> Either ParseError WorksheetFile
worksheetFile forall {a}. IsString a => a
wbPath Relationships
wbRels) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Cursor -> [Text]
attribute Name
"name" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef Name
"state" forall a. Default a => a
def forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute (Text -> Name
odr Text
"id")
  let cacheRefs :: [(a, b)]
cacheRefs =
        Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"pivotCaches") forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
n_ Text
"pivotCache") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"cacheId" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute (Text -> Name
odr Text
"id")
  Caches
caches <-
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM forall {a} {b}. (FromAttrVal a, FromAttrVal b) => [(a, b)]
cacheRefs forall a b. (a -> b) -> a -> b
$ \(CacheId
cacheId, RefId
rId) -> do
      [Char]
path <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath forall {a}. IsString a => a
wbPath Relationships
wbRels RefId
rId
      ByteString
bs <-
        forall a b. a -> Maybe b -> Either a b
note ([Char] -> ParseError
MissingFile [Char]
path) forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry 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) <-
        forall a b. a -> Maybe b -> Either a b
note (Text -> ParseError
InconsistentXlsx forall a b. (a -> b) -> a -> b
$ Text
"Bad pivot table cache in " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
path) 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"r") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Cursor
cur' ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Cursor
cur' forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Axis
anyElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [CacheRecordValue]
recordValueFromNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node. Cursor node -> node
node
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [CacheField] -> [[CacheRecordValue]] -> [CacheField]
fillCacheFieldsFromRecords [CacheField]
fields0 [[CacheRecordValue]]
recs
        Maybe RefId
Nothing ->
          forall (m :: * -> *) a. Monad m => a -> m a
return [CacheField]
fields0
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (CacheId
cacheId, (Text
sheet, Range
ref, [CacheField]
fields))
  let dateBase :: DateBase
dateBase = forall a. a -> a -> Bool -> a
bool DateBase
DateBase1900 DateBase
DateBase1904 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
                 Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"workbookPr") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"date1904"
  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
  forall e a. e -> [a] -> Either e a
headErr ([Char] -> Text -> ParseError
InvalidFile [Char]
fp Text
"Couldn't parse drawing") (forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur)

worksheetFile :: FilePath -> Relationships -> Text -> SheetState -> RefId -> Parser WorksheetFile
worksheetFile :: [Char]
-> Relationships
-> Text
-> SheetState
-> RefId
-> Either ParseError WorksheetFile
worksheetFile [Char]
parentPath Relationships
wbRels Text
name SheetState
visibility RefId
rId =
  Text -> SheetState -> [Char] -> WorksheetFile
WorksheetFile Text
name SheetState
visibility 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Relationships
Relationships.empty ([Char] -> Relationships -> Relationships
setTargetsFrom [Char]
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Partial => [Char] -> [a] -> a
headNote [Char]
"Missing rels" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)