{-# 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 (headNote)
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 = (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. Partial => [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 String
                | 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
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: 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
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> [Char]
show :: ParseError -> [Char]
$cshowList :: [ParseError] -> ShowS
showList :: [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
$cfrom :: forall x. ParseError -> Rep ParseError x
from :: forall x. ParseError -> Rep ParseError x
$cto :: forall x. Rep ParseError x -> ParseError
to :: forall x. Rep ParseError x -> ParseError
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. Partial => [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
  ar <- ([Char] -> ParseError)
-> Either [Char] Archive -> Either ParseError Archive
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left [Char] -> 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
  sst <- getSharedStrings ar
  contentTypes <- getContentTypes ar
  (wfs, names, cacheSources, dateBase) <- readWorkbook ar
  sheets <- forM wfs $ \WorksheetFile
wf -> do
      sheet <- Archive
-> SharedStringTable
-> ContentTypes
-> Caches
-> WorksheetFile
-> Parser Worksheet
parseSheet Archive
ar SharedStringTable
sst ContentTypes
contentTypes Caches
cacheSources WorksheetFile
wf
      return . (wfName wf,) . (wsState .~ wfState wf) $ sheet
  CustomProperties customPropMap <- getCustomProperties ar
  return $ Xlsx sheets (getStyles ar) names customPropMap dateBase

data WorksheetFile = WorksheetFile { WorksheetFile -> Text
wfName :: Text
                                   , WorksheetFile -> SheetState
wfState :: SheetState
                                   , 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
$cshowsPrec :: Int -> WorksheetFile -> ShowS
showsPrec :: Int -> WorksheetFile -> ShowS
$cshow :: WorksheetFile -> [Char]
show :: WorksheetFile -> [Char]
$cshowList :: [WorksheetFile] -> ShowS
showList :: [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
$cfrom :: forall x. WorksheetFile -> Rep WorksheetFile x
from :: forall x. WorksheetFile -> Rep WorksheetFile x
$cto :: forall x. Rep WorksheetFile x -> WorksheetFile
to :: forall x. Rep WorksheetFile x -> WorksheetFile
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
  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
  sheetRels <- getRels ar filePath
  root <-
    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)) $
    Xeno.parse (LB.toStrict file)
  parseWorksheet root 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 ByteString
forall {a}. IsString a => a
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
      (ws, tableIds, drawingRId, 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"
          _wsSheetViews <- (Maybe [SheetView] -> Maybe [SheetView])
-> ChildCollector (Maybe [SheetView])
-> ChildCollector (Maybe [SheetView])
forall a b. (a -> b) -> ChildCollector a -> ChildCollector b
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"
          skip "sheetFormatPr"
          _wsColumnsProperties <-
            fmap (fromMaybe []) . maybeParse "cols" $ \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")
          (_wsRowPropertiesMap, _wsCells, _wsSharedFormulas) <-
            requireAndParse "sheetData" $ \Node
n -> do
              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"
              collectRows <$> forM rows parseRow
          skip "sheetCalcPr"
          _wsProtection <- maybeFromChild "sheetProtection"
          skip "protectedRanges"
          skip "scenarios"
          _wsAutoFilter <- maybeFromChild "autoFilter"
          skip "sortState"
          skip "dataConsolidate"
          skip "customSheetViews"
          _wsMerges <- fmap (fromMaybe []) . maybeParse "mergeCells" $ \Node
n -> do
            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"
            forM mCells $ \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"
          _wsConditionalFormattings <-
            M.fromList . map unCfPair <$> fromChildList "conditionalFormatting"
          _wsDataValidations <-
            fmap (fromMaybe mempty) . maybeParse "dataValidations" $ \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")
          skip "hyperlinks"
          skip "printOptions"
          skip "pageMargins"
          _wsPageSetup <- maybeFromChild "pageSetup"
          skip "headerFooter"
          skip "rowBreaks"
          skip "colBreaks"
          skip "customProperties"
          skip "cellWatches"
          skip "ignoredErrors"
          skip "smartTags"
          drawingRId <- maybeParse "drawing" $ \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")
          legacyDrRId <- maybeParse "legacyDrawing" $ \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")
          tableIds <- fmap (fromMaybe []) . maybeParse "tableParts" $ \Node
n -> do
            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"
            forM tParts $ \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
          return (
            Worksheet
            { _wsDrawing = Nothing
            , _wsPivotTables = []
            , _wsTables = []
            , _wsState = wfState wf
            , ..
            }
            , tableIds
            , drawingRId
            , legacyDrRId)

      let commentsType = a
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments"
          commentTarget :: Maybe FilePath
          commentTarget = ShowS
logicalNameToZipItemName ShowS -> (Relationship -> [Char]) -> Relationship -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 {a}. IsString a => a
commentsType Relationships
sheetRels
          legacyDrPath = (Relationship -> [Char]) -> Maybe Relationship -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS
logicalNameToZipItemName ShowS -> (Relationship -> [Char]) -> Relationship -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
      commentsMap <-
        fmap join . forM commentTarget $ getComments ar legacyDrPath
      let commentCells =
            [((RowIndex, ColumnIndex), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
            [ (Range -> (RowIndex, ColumnIndex)
fromSingleCellRefNoting Range
r, Cell
forall a. Default a => a
def { _cellComment = Just 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
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 = (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
      tables <- forM tableIds $ \RefId
rId -> do
        fp <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
filePath Relationships
sheetRels RefId
rId
        getTable ar fp
      drawing <- forM drawingRId $ \RefId
dId -> do
        fp <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
filePath Relationships
sheetRels RefId
dId
        getDrawing ar contentTypes fp
      let ptType = a
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable"
      pivotTables <- forM (allByType ptType sheetRels) $ \Relationship
rel -> do
        let ptPath :: [Char]
ptPath = ShowS
logicalNameToZipItemName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Relationship -> [Char]
relTarget Relationship
rel
        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
        note (InconsistentXlsx $ "Bad pivot table in " <> T.pack ptPath) $
          parsePivotTable (flip Prelude.lookup caches) bs

      return $ ws & wsTables .~ tables
                  & wsCells %~ mergeComments
                  & wsDrawing .~ drawing
                  & wsPivotTables .~ pivotTables
    liftEither :: Either Text a -> Parser a
    liftEither :: forall a. Either Text a -> Parser a
liftEither = (Text -> ParseError) -> Either Text a -> Either ParseError a
forall b c d. (b -> c) -> Either b d -> Either c d
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 (RowIndex, Maybe RowProperties,
   [(RowIndex, ColumnIndex, Cell,
     Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
collectRows = ((RowIndex, Maybe RowProperties,
  [(RowIndex, ColumnIndex, Cell,
    Maybe (SharedFormulaIndex, SharedFormulaOptions))])
 -> (Map RowIndex RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions)
 -> (Map RowIndex RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions))
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> t (RowIndex, Maybe RowProperties,
      [(RowIndex, ColumnIndex, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
forall a b. (a -> b -> b) -> b -> t a -> b
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 (Map RowIndex 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 ::
         ( 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) =
            [(((RowIndex, ColumnIndex), Cell),
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
-> ([((RowIndex, ColumnIndex), Cell)],
    [Maybe (SharedFormulaIndex, SharedFormulaOptions)])
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 = [((RowIndex, ColumnIndex), Cell)] -> CellMap
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList [((RowIndex, ColumnIndex), 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 RowIndex RowProperties
newRowMap =
            case Maybe RowProperties
mRP of
              Just RowProperties
rp -> RowIndex
-> RowProperties
-> Map RowIndex RowProperties
-> Map RowIndex RowProperties
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 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 ( 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
      (r, s, ht, cstHt, 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 a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
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 a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
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 a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
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 a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
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 =
            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
            }
      cellNodes <- collectChildren row $ childList "c"
      cells <- forM cellNodes parseCell
      return
        ( RowIndex r
        , if props == def
            then Nothing
            else Just props
        , 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
      (ref, s, 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 a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
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 a b. AttrParser (a -> b) -> AttrParser a -> AttrParser b
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"
      (fNode, vNode, isNode) <-
        collectChildren cell $
        (,,) <$> maybeChild "f" <*> maybeChild "v" <*> maybeChild "is"
      let vConverted :: (FromAttrBs a) => 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 a. a -> Either Text 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
      mFormulaData <- mapM fromXenoNode fNode
      d <-
        case t of
          (ByteString
"s" :: ByteString) -> do
            si <- Either Text (Maybe Int)
forall a. FromAttrBs a => Either Text (Maybe a)
vConverted
            case sstItem sst =<< si of
              Just XlsxText
xlTxt -> Maybe CellValue -> Either Text (Maybe CellValue)
forall a. a -> Either Text a
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 a. Text -> Either Text a
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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM ((XlsxText -> CellValue)
-> Either Text XlsxText -> Either Text CellValue
forall a b. (a -> b) -> Either Text a -> Either Text b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a. Text -> Either Text a
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 (r, c) = fromSingleCellRefNoting ref
          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 = 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
      return (r, c, Cell s d Nothing f, 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
  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
  cur <- fmap fromDocument . 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)) $
         parseLBS def file
  sheetRels <- getRels ar 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 = 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 = 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 = a
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments"
      commentTarget :: Maybe FilePath
      commentTarget = ShowS
logicalNameToZipItemName ShowS -> (Relationship -> [Char]) -> Relationship -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 {a}. IsString a => a
commentsType Relationships
sheetRels
      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 = (Relationship -> [Char]) -> Maybe Relationship -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS
logicalNameToZipItemName ShowS -> (Relationship -> [Char]) -> Relationship -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

  commentsMap :: Maybe CommentTable <- maybe (Right Nothing) (getComments ar legacyDrPath) commentTarget

  -- Likewise, @pageSetup@ also occurs either 0 or 1 times
  let 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 = 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

      (rowProps, cells0, sharedFormulas) =
        collect $ cur $/ element (n_ "sheetData") &/ element (n_ "row") >=> parseRow
      parseRow ::
           Cursor
        -> [( RowIndex
            , Maybe RowProperties
            , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
      parseRow Cursor
c = do
        r <- Int -> RowIndex
RowIndex (Int -> RowIndex) -> [Int] -> [RowIndex]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Cursor -> [Int]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"r" Cursor
c
        let prop = RowProps
              { rowHeight :: Maybe RowHeight
rowHeight = do 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 fromAttribute "customHeight" c of
                                 [Bool
True] -> RowHeight -> Maybe RowHeight
forall a. a -> Maybe a
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 a. a -> Maybe a
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
              }
        return ( r
               , if prop == def then Nothing else Just prop
               , c $/ element (n_ "c") >=> parseCell
               )
      parseCell ::
           Cursor
        -> [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
      parseCell Cursor
cell = do
        ref <- Name -> Cursor -> [Range]
forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
"r" Cursor
cell
        let 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
            -- 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 -> 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 = [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 = [(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 = (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 = (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
            (r, c) = fromSingleCellRefNoting ref
            comment = Maybe CommentTable
commentsMap Maybe CommentTable
-> (CommentTable -> Maybe Comment) -> Maybe Comment
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Range -> CommentTable -> Maybe Comment
lookupComment Range
ref
        return (r, c, Cell s d comment f, shared)
      collect = ((RowIndex, Maybe RowProperties,
  [(RowIndex, ColumnIndex, Cell,
    Maybe (SharedFormulaIndex, SharedFormulaOptions))])
 -> (Map RowIndex RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions)
 -> (Map RowIndex RowProperties, CellMap,
     Map SharedFormulaIndex SharedFormulaOptions))
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
-> t (RowIndex, Maybe RowProperties,
      [(RowIndex, ColumnIndex, Cell,
        Maybe (SharedFormulaIndex, SharedFormulaOptions))])
-> (Map RowIndex RowProperties, CellMap,
    Map SharedFormulaIndex SharedFormulaOptions)
forall a b. (a -> b -> b) -> b -> t a -> b
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 (Map RowIndex 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 ::
           ( 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) =
              [(((RowIndex, ColumnIndex), Cell),
  Maybe (SharedFormulaIndex, SharedFormulaOptions))]
-> ([((RowIndex, ColumnIndex), Cell)],
    [Maybe (SharedFormulaIndex, SharedFormulaOptions)])
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 = [((RowIndex, ColumnIndex), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((RowIndex, ColumnIndex), 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 RowIndex RowProperties
newRowMap = case Maybe RowProperties
mRP of
              Just RowProperties
rp -> RowIndex
-> RowProperties
-> Map RowIndex RowProperties
-> Map RowIndex RowProperties
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 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 =
        [((RowIndex, ColumnIndex), Cell)] -> CellMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
          [ (Range -> (RowIndex, ColumnIndex)
fromSingleCellRefNoting Range
r, Cell
forall a. Default a => a
def {_cellComment = Just 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
cells0 CellMap -> CellMap -> CellMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` CellMap
commentCells

      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 = [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 = Cursor
cur Cursor -> (Cursor -> [Range]) -> [Range]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Range]
parseMerges
      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 = [(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 = [(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 =
        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 = [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

  mDrawing <- case mDrawingId of
      Just RefId
dId -> do
          fp <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
filePath Relationships
sheetRels RefId
dId
          Just <$> getDrawing ar contentTypes fp
      Maybe RefId
Nothing  ->
          Maybe Drawing -> Either ParseError (Maybe Drawing)
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drawing
forall a. Maybe a
Nothing

  let ptType = a
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable"
  pTables <- forM (allByType ptType sheetRels) $ \Relationship
rel -> do
    let ptPath :: [Char]
ptPath = ShowS
logicalNameToZipItemName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Relationship -> [Char]
relTarget Relationship
rel
    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
    note (InconsistentXlsx $ "Bad pivot table in " <> T.pack ptPath) $
      parsePivotTable (flip Prelude.lookup caches) bs

  tables <- forM tableIds $ \RefId
rId -> do
    fp <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
filePath Relationships
sheetRels RefId
rId
    getTable ar fp

  return $
    Worksheet
      cws
      rowProps
      cells
      mDrawing
      merges
      sheetViews
      pageSetup
      condFormtattings
      validations
      pTables
      mAutoFilter
      tables
      mProtection
      sharedFormulas
      (wfState wf)

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
    si <- [Char] -> [Int]
forall {b}. FromAttrVal b => [Char] -> [b]
vConverted [Char]
"shared string"
    case sstItem sst si of
      Just XlsxText
xlTxt -> CellValue -> [CellValue]
forall a. a -> [a]
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 a. [Char] -> [a]
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 a b. (a -> b) -> [a] -> [b]
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 a. [Char] -> [a]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"bad cell value"
  where
    vConverted :: [Char] -> [b]
vConverted [Char]
typeStr = do
      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 a. a -> [a]
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 fromAttrVal vContent of
        Right (b
val, Text
_) -> b -> [b]
forall a. a -> [a]
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 a. [Char] -> [a]
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 a.
Either ParseError a
-> (ParseError -> Either ParseError a) -> Either ParseError a
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 :: forall a. ParseError -> Either ParseError (Maybe a)
missingToNothing (MissingFile [Char]
_) = Maybe a -> Either ParseError (Maybe a)
forall a. a -> Either ParseError 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 a. ParseError -> Either ParseError 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 <- 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
    cur <- 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)) $ parseLBS def (Zip.fromEntry entry)
    return $ fromDocument 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
  mCur <- Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
x [Char]
fp
  case mCur of
    Just Cursor
cur ->
      ParseError -> [a] -> Either ParseError 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] -> Either ParseError a) -> [a] -> Either ParseError a
forall a b. (a -> b) -> a -> b
$ Cursor -> [a]
forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
    Maybe Cursor
Nothing -> a -> Either ParseError a
forall a. a -> Either ParseError a
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
  cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
x [Char]
fp
  headErr (InvalidFile fp $ "Couldn't parse " <> contentsDescr) $ fromCursor 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
    mCurComments <- Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
ar [Char]
fp
    mCurDr <- maybe (return Nothing) (xmlCursorOptional ar) drp
    return (liftA2 hide (hidden <$> mCurDr) . listToMaybe . fromCursor =<< 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 b a. (b -> a -> b) -> b -> t a -> b
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 = 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 :: Name
elementAttributes :: Map Name Text
elementNodes :: [Node]
elementNodes :: Element -> [Node]
elementAttributes :: Element -> Map Name Text
elementName :: Element -> 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
        r0 <- Cursor
c Cursor -> (Cursor -> [RowIndex]) -> [RowIndex]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xText
"Row") Axis -> (Cursor -> [RowIndex]) -> Cursor -> [RowIndex]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content (Cursor -> [Text]) -> (Text -> [RowIndex]) -> Cursor -> [RowIndex]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [RowIndex]
forall (m :: * -> *) a. (MonadFail m, Integral a) => Text -> m a
decimal
        c0 <- c $/ element (x"Column") &/ content >=> decimal
        return $ singleCellRef (r0 + 1, c0 + 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
    cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
fp
    drawingRels <- getRels ar fp
    unresolved <- headErr (InvalidFile fp "Couldn't parse drawing") (fromCursor cur)
    anchors <- forM (unresolved ^. xdrAnchors) $ resolveFileInfo drawingRels
    return $ Drawing 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 (f :: * -> *).
Functor f =>
(DrawingObject p1 g1 -> f (DrawingObject p2 g2))
-> Anchor p1 g1 -> f (Anchor p2 g2)
anchObject of
        Picture {Bool
Maybe Text
ShapeProperties
BlipFillProperties RefId
PicNonVisual
_picMacro :: Maybe Text
_picPublished :: Bool
_picNonVisual :: PicNonVisual
_picBlipFill :: BlipFillProperties RefId
_picShapeProperties :: ShapeProperties
_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
..} -> 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 (f :: * -> *).
Functor f =>
(Maybe a1 -> f (Maybe a2))
-> BlipFillProperties a1 -> f (BlipFillProperties a2)
bfpImageInfo
          mFI <- Relationships -> Maybe RefId -> Either ParseError (Maybe FileInfo)
lookupFI Relationships
rels Maybe RefId
mRefId
          let 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 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 (f :: * -> *).
Functor f =>
(Maybe a1 -> f (Maybe a2))
-> BlipFillProperties a1 -> f (BlipFillProperties 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
                }
          return uAnch {_anchObject = pic'}
        Graphic GraphNonVisual
nv RefId
rId Transform2D
tr -> do
          chartPath <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
fp Relationships
rels RefId
rId
          chart <- readChart ar chartPath
          return uAnch {_anchObject = Graphic nv chart tr}
    lookupFI :: Relationships -> Maybe RefId -> Either ParseError (Maybe FileInfo)
lookupFI Relationships
_ Maybe RefId
Nothing = Maybe FileInfo -> Either ParseError (Maybe FileInfo)
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileInfo
forall a. Maybe a
Nothing
    lookupFI Relationships
rels (Just RefId
rId) = do
      path <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
fp Relationships
rels RefId
rId
        -- content types use paths starting with /
      contentType <-
        note (InvalidFile path "Missing content type") $
        ContentTypes.lookup ("/" <> path) contentTypes
      contents <-
        Zip.fromEntry <$> note (MissingFile path) (Zip.findEntryByPath path ar)
      return . Just $ FileInfo (stripMediaPrefix path) contentType 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 :: a
wbPath = a
"xl/workbook.xml"
  cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
forall {a}. IsString a => a
wbPath
  wbRels <- getRels ar wbPath
  -- Specification says the 'name' is required.
  let mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]
      mkDefinedName Cursor
c =
        (Text, Maybe Text, Text) -> [(Text, Maybe Text, Text)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( [Char] -> [Text] -> Text
forall a. Partial => [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 =
        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
  sheets <-
    sequence $
    cur $/ element (n_ "sheets") &/ element (n_ "sheet") >=>
    liftA3 (worksheetFile wbPath wbRels) <$> attribute "name" <*> fromAttributeDef "state" def <*>
    fromAttribute (odr "id")
  let 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 a b c. (a -> b -> c) -> [a] -> [b] -> [c]
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 a b. (Cursor -> a -> b) -> (Cursor -> a) -> Cursor -> 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 <-
    forM cacheRefs $ \(CacheId
cacheId, RefId
rId) -> do
      path <- [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
forall {a}. IsString a => a
wbPath Relationships
wbRels RefId
rId
      bs <-
        note (MissingFile path) $ Zip.fromEntry <$> Zip.findEntryByPath path ar
      (sheet, ref, fields0, mRecRId) <-
        note (InconsistentXlsx $ "Bad pivot table cache in " <> T.pack path) $
        parseCache bs
      fields <- case mRecRId of
        Just RefId
recId -> do
          cacheRels <- Archive -> [Char] -> Parser Relationships
getRels Archive
ar [Char]
path
          recsPath <- lookupRelPath path cacheRels recId
          rCur <- xmlCursorRequired ar recsPath
          let 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 a. a -> [a]
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
          return $ fillCacheFieldsFromRecords fields0 recs
        Maybe RefId
Nothing ->
          [CacheField] -> Either ParseError [CacheField]
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return [CacheField]
fields0
      return $ (cacheId, (sheet, ref, fields))
  let 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"
  return (sheets, DefinedNames names, caches, dateBase)

getTable :: Zip.Archive -> FilePath -> Parser Table
getTable :: Archive -> [Char] -> Either ParseError Table
getTable Archive
ar [Char]
fp = do
  cur <- Archive -> [Char] -> Either ParseError Cursor
xmlCursorRequired Archive
ar [Char]
fp
  headErr (InvalidFile fp "Couldn't parse drawing") (fromCursor 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 ([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"
    c <- Archive -> [Char] -> Parser (Maybe Cursor)
xmlCursorOptional Archive
ar [Char]
relsPath
    return $ maybe Relationships.empty (setTargetsFrom fp . headNote "Missing rels" . fromCursor) c

-- According to part 2, section 7.3.4 of ECMA-376, when mapping logical item
-- names to ZIP item names we need to remove the leading slash.
--
-- Non-ASCII characters should be percent-encoded as well, but this is not
-- currently implemented.
--
-- https://ecma-international.org/publications-and-standards/standards/ecma-376/
logicalNameToZipItemName :: FilePath -> FilePath
logicalNameToZipItemName :: ShowS
logicalNameToZipItemName (Char
'/' : [Char]
name) = [Char]
name
logicalNameToZipItemName [Char]
name = [Char]
name

lookupRelPath :: FilePath
              -> Relationships
              -> RefId
              -> Either ParseError FilePath
lookupRelPath :: [Char] -> Relationships -> RefId -> Either ParseError [Char]
lookupRelPath [Char]
fp Relationships
rels RefId
rId =
  ShowS
logicalNameToZipItemName ShowS -> (Relationship -> [Char]) -> Relationship -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)