content: {-# 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)
  import Codec.Xlsx.LensCompat hiding ((<.>), element, views)
  import Control.Monad (join, void, liftM4)
  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 = either (error . show) id . toXlsxEither
  
  data ParseError = InvalidZipArchive String
                  | MissingFile FilePath
                  | InvalidFile FilePath Text
                  | InvalidRef FilePath RefId
                  | InconsistentXlsx Text
                  deriving (Eq, Show, 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 = either (error . show) id . toXlsxEitherFast
  
  -- | Reads `Xlsx' from raw data (lazy bytestring), failing with 'Left' on parse error
  toXlsxEither :: L.ByteString -> Parser Xlsx
  toXlsxEither = toXlsxEitherBase extractSheet
  
  -- | Fast parsing with 'Left' on parse error, see 'toXlsxFast'
  toXlsxEitherFast :: L.ByteString -> Parser Xlsx
  toXlsxEitherFast = toXlsxEitherBase extractSheetFast
  
  toXlsxEitherBase ::
       (Zip.Archive -> SharedStringTable -> ContentTypes -> Caches -> WorksheetFile -> Parser Worksheet)
    -> L.ByteString
    -> Parser Xlsx
  toXlsxEitherBase parseSheet bs = do
    ar <- left InvalidZipArchive $ Zip.toArchiveOrFail bs
    sst <- getSharedStrings ar
    contentTypes <- getContentTypes ar
    (wfs, names, cacheSources, dateBase) <- readWorkbook ar
    sheets <- forM wfs $ \wf -> do
        sheet <- parseSheet ar sst contentTypes cacheSources wf
        return . (wfName wf,) . (wsState .~ wfState wf) $ sheet
    CustomProperties customPropMap <- getCustomProperties ar
    return $ Xlsx sheets (getStyles ar) names customPropMap dateBase
  
  data WorksheetFile = WorksheetFile { wfName :: Text
                                     , wfSheetId :: Int
                                     , wfState :: SheetState
                                     , wfPath :: FilePath
                                     }
                     deriving (Show, Generic)
  
  type Caches = [(CacheId, (Text, CellRef, [CacheField]))]
  
  extractSheetFast :: Zip.Archive
                   -> SharedStringTable
                   -> ContentTypes
                   -> Caches
                   -> WorksheetFile
                   -> Parser Worksheet
  extractSheetFast ar sst contentTypes caches wf = do
    file <-
      note (MissingFile filePath) $
      Zip.fromEntry <$> Zip.findEntryByPath filePath ar
    sheetRels <- getRels ar filePath
    root <-
      left (\ex -> InvalidFile filePath $ T.pack (show ex)) $
      Xeno.parse (LB.toStrict file)
    parseWorksheet root sheetRels
    where
      filePath = wfPath wf
      parseWorksheet :: Xeno.Node -> Relationships -> Parser Worksheet
      parseWorksheet root sheetRels = do
        let prefixes = nsPrefixes root
            odrNs =
              "http://schemas.openxmlformats.org/officeDocument/2006/relationships"
            odrX = addPrefix prefixes odrNs
            skip = void . maybeChild
        (ws, tableIds, drawingRId, legacyDrRId) <-
          liftEither . collectChildren root $ do
            skip "sheetPr"
            skip "dimension"
            _wsSheetViews <- fmap justNonEmpty . maybeParse "sheetViews" $ \n ->
              collectChildren n $ fromChildList "sheetView"
            skip "sheetFormatPr"
            _wsColumnsProperties <-
              fmap (fromMaybe []) . maybeParse "cols" $ \n ->
                collectChildren n (fromChildList "col")
            (_wsRowPropertiesMap, _wsCells, _wsSharedFormulas) <-
              requireAndParse "sheetData" $ \n -> do
                rows <- collectChildren n $ childList "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" $ \n -> do
              mCells <- collectChildren n $ childList "mergeCell"
              forM mCells $ \mCell -> parseAttributes mCell $ fromAttr "ref"
            _wsConditionalFormattings <-
              M.fromList . map unCfPair <$> fromChildList "conditionalFormatting"
            _wsDataValidations <-
              fmap (fromMaybe mempty) . maybeParse "dataValidations" $ \n -> do
                M.fromList . map unDvPair <$>
                  collectChildren n (fromChildList "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" $ \n ->
              parseAttributes n $ fromAttr (odrX "id")
            legacyDrRId <- maybeParse "legacyDrawing" $ \n ->
              parseAttributes n $ fromAttr (odrX "id")
            tableIds <- fmap (fromMaybe []) . maybeParse "tableParts" $ \n -> do
              tParts <- collectChildren n $ childList "tablePart"
              forM tParts $ \part ->
                parseAttributes part $ fromAttr (odrX "id")
  
            -- all explicitly assigned fields filled below
            return (
              Worksheet
              { _wsDrawing = Nothing
              , _wsPivotTables = []
              , _wsTables = []
              , _wsState = wfState wf
              , ..
              }
              , tableIds
              , drawingRId
              , legacyDrRId)
  
        let commentsType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments"
            commentTarget :: Maybe FilePath
            commentTarget = logicalNameToZipItemName . relTarget <$> findRelByType commentsType sheetRels
            legacyDrPath = fmap (logicalNameToZipItemName . relTarget) . flip Relationships.lookup sheetRels =<< legacyDrRId
        commentsMap <-
          fmap join . forM commentTarget $ getComments ar legacyDrPath
        let commentCells =
              M.fromList
              [ (fromSingleCellRefNoting r, def { _cellComment = Just cmnt})
              | (r, cmnt) <- maybe [] CommentTable.toList commentsMap
              ]
            assignComment withCmnt noCmnt =
              noCmnt & cellComment .~ (withCmnt ^. cellComment)
            mergeComments = M.unionWith assignComment commentCells
        tables <- forM tableIds $ \rId -> do
          fp <- lookupRelPath filePath sheetRels rId
          getTable ar fp
        drawing <- forM drawingRId $ \dId -> do
          fp <- lookupRelPath filePath sheetRels dId
          getDrawing ar contentTypes fp
        let ptType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable"
        pivotTables <- forM (allByType ptType sheetRels) $ \rel -> do
          let ptPath = logicalNameToZipItemName $ relTarget rel
          bs <- note (MissingFile ptPath) $ Zip.fromEntry <$> Zip.findEntryByPath ptPath 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 = left (\t -> InvalidFile filePath t)
      justNonEmpty v@(Just (_:_)) = v
      justNonEmpty _ = Nothing
      collectRows = foldr collectRow (M.empty, M.empty, 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 (r, mRP, rowCells) (rowMap, cellMap, sharedF) =
        let (newCells0, newSharedF0) =
              unzip [(((rInd, cInd), cd), shared) | (rInd, cInd, cd, shared) <- rowCells]
            newCells = M.fromAscList newCells0
            newSharedF = M.fromAscList $ catMaybes newSharedF0
            newRowMap =
              case mRP of
                Just rp -> M.insert r rp rowMap
                Nothing -> rowMap
        in (newRowMap, cellMap <> newCells, sharedF <> newSharedF)
      parseRow ::
           Xeno.Node
        -> Either Text ( RowIndex
                       , Maybe RowProperties
                       , [( RowIndex
                          , ColumnIndex
                          , Cell
                          , Maybe (SharedFormulaIndex, SharedFormulaOptions))])
      parseRow row = do
        (r, s, ht, cstHt, hidden) <-
          parseAttributes row $
          ((,,,,) <$> fromAttr "r" <*> maybeAttr "s" <*> maybeAttr "ht" <*>
           fromAttrDef "customHeight" False <*>
           fromAttrDef "hidden" False)
        let props =
              RowProps
              { rowHeight =
                  if cstHt
                    then CustomHeight <$> ht
                    else AutomaticHeight <$> ht
              , rowStyle = s
              , rowHidden = 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 cell = do
        (ref, s, t) <-
          parseAttributes cell $
          (,,) <$> fromAttr "r" <*> maybeAttr "s" <*> fromAttrDef "t" "n"
        (fNode, vNode, isNode) <-
          collectChildren cell $
          (,,) <$> maybeChild "f" <*> maybeChild "v" <*> maybeChild "is"
        let vConverted :: (FromAttrBs a) => Either Text (Maybe a)
            vConverted =
              case contentBs <$> vNode of
                Nothing -> return Nothing
                Just c -> Just <$> fromAttrBs c
        mFormulaData <- mapM fromXenoNode fNode
        d <-
          case t of
            ("s" :: ByteString) -> do
              si <- vConverted
              case sstItem sst =<< si of
                Just xlTxt -> return $ Just (xlsxTextToCellValue xlTxt)
                Nothing -> throwError "bad shared string index"
            "inlineStr" -> mapM (fmap xlsxTextToCellValue . fromXenoNode) isNode
            "str" -> fmap CellText <$> vConverted
            "n" -> fmap CellDouble <$> vConverted
            "b" -> fmap CellBool <$> vConverted
            "e" -> fmap CellError <$> vConverted
            unexpected ->
              throwError $ "unexpected cell type " <> T.pack (show unexpected)
        let (r, c) = fromSingleCellRefNoting ref
            f = frmdFormula <$> mFormulaData
            shared = frmdShared =<< mFormulaData
        return (r, c, Cell s d Nothing f, shared)
  
  extractSheet ::
       Zip.Archive
    -> SharedStringTable
    -> ContentTypes
    -> Caches
    -> WorksheetFile
    -> Parser Worksheet
  extractSheet ar sst contentTypes caches wf = do
    let filePath = wfPath wf
    file <- note (MissingFile filePath) $ Zip.fromEntry <$> Zip.findEntryByPath filePath ar
    cur <- fmap fromDocument . left (\ex -> InvalidFile filePath (T.pack $ show 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 = cur $/ element (addSmlNamespace "sheetViews") &/ element (addSmlNamespace "sheetView") >=> fromCursor
         sheetViews = case sheetViewList of
           []    -> Nothing
           views -> Just views
  
    let commentsType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments"
        commentTarget :: Maybe FilePath
        commentTarget = logicalNameToZipItemName . relTarget <$> findRelByType commentsType sheetRels
        legacyDrRId = cur $/ element (addSmlNamespace "legacyDrawing") >=> fromAttribute (odr"id")
        legacyDrPath = fmap (logicalNameToZipItemName . relTarget) . flip Relationships.lookup sheetRels  =<< listToMaybe legacyDrRId
  
    commentsMap :: Maybe CommentTable <- maybe (Right Nothing) (getComments ar legacyDrPath) commentTarget
  
    -- Likewise, @pageSetup@ also occurs either 0 or 1 times
    let pageSetup = listToMaybe $ cur $/ element (addSmlNamespace "pageSetup") >=> fromCursor
  
        cws = cur $/ element (addSmlNamespace "cols") &/ element (addSmlNamespace "col") >=> fromCursor
  
        (rowProps, cells0, sharedFormulas) =
          collect $ cur $/ element (addSmlNamespace "sheetData") &/ element (addSmlNamespace "row") >=> parseRow
        parseRow ::
             Cursor
          -> [( RowIndex
              , Maybe RowProperties
              , [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))])]
        parseRow c = do
          r <- RowIndex <$> fromAttribute "r" c
          let prop = RowProps
                { rowHeight = do h <- listToMaybe $ fromAttribute "ht" c
                                 case fromAttribute "customHeight" c of
                                   [True] -> return $ CustomHeight    h
                                   _      -> return $ AutomaticHeight h
                , rowStyle  = listToMaybe $ fromAttribute "s" c
                , rowHidden =
                    case fromAttribute "hidden" c of
                      []  -> False
                      f:_ -> f
                }
          return ( r
                 , if prop == def then Nothing else Just prop
                 , c $/ element (addSmlNamespace "c") >=> parseCell
                 )
        parseCell ::
             Cursor
          -> [(RowIndex, ColumnIndex, Cell, Maybe (SharedFormulaIndex, SharedFormulaOptions))]
        parseCell cell = do
          ref <- fromAttribute "r" cell
          let s = listToMaybe $ cell $| attribute "s" >=> 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 = fromMaybe "n" $ listToMaybe $ cell $| attribute "t"
              d = listToMaybe $ extractCellValue sst t cell
              mFormulaData = listToMaybe $ cell $/ element (addSmlNamespace "f") >=> formulaDataFromCursor
              f = fst <$> mFormulaData
              shared = snd =<< mFormulaData
              (r, c) = fromSingleCellRefNoting ref
              comment = commentsMap >>= lookupComment ref
          return (r, c, Cell s d comment f, shared)
        collect = foldr collectRow (M.empty, M.empty, 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 (r, mRP, rowCells) (rowMap, cellMap, sharedF) =
          let (newCells0, newSharedF0) =
                unzip [(((x,y),cd), shared) | (x, y, cd, shared) <- rowCells]
              newCells = M.fromList newCells0
              newSharedF = M.fromList $ catMaybes newSharedF0
              newRowMap = case mRP of
                Just rp -> M.insert r rp rowMap
                Nothing -> rowMap
          in (newRowMap, cellMap <> newCells, sharedF <> newSharedF)
  
        commentCells =
          M.fromList
            [ (fromSingleCellRefNoting r, def {_cellComment = Just cmnt})
            | (r, cmnt) <- maybe [] CommentTable.toList commentsMap
            ]
        cells = cells0 `M.union` commentCells
  
        mProtection = listToMaybe $ cur $/ element (addSmlNamespace "sheetProtection") >=> fromCursor
  
        mDrawingId = listToMaybe $ cur $/ element (addSmlNamespace "drawing") >=> fromAttribute (odr"id")
  
        merges = cur $/ parseMerges
        parseMerges :: Cursor -> [Range]
        parseMerges = element (addSmlNamespace "mergeCells") &/ element (addSmlNamespace "mergeCell") >=> fromAttribute "ref"
  
        condFormtattings = M.fromList . map unCfPair  $ cur $/ element (addSmlNamespace "conditionalFormatting") >=> fromCursor
  
        validations = M.fromList . map unDvPair $
            cur $/ element (addSmlNamespace "dataValidations") &/ element (addSmlNamespace "dataValidation") >=> fromCursor
  
        tableIds =
          cur $/ element (addSmlNamespace "tableParts") &/ element (addSmlNamespace "tablePart") >=>
          fromAttribute (odr "id")
  
    let mAutoFilter = listToMaybe $ cur $/ element (addSmlNamespace "autoFilter") >=> fromCursor
  
    mDrawing <- case mDrawingId of
        Just dId -> do
            fp <- lookupRelPath filePath sheetRels dId
            Just <$> getDrawing ar contentTypes fp
        Nothing  ->
            return Nothing
  
    let ptType = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/pivotTable"
    pTables <- forM (allByType ptType sheetRels) $ \rel -> do
      let ptPath = logicalNameToZipItemName $ relTarget rel
      bs <- note (MissingFile ptPath) $ Zip.fromEntry <$> Zip.findEntryByPath ptPath ar
      note (InconsistentXlsx $ "Bad pivot table in " <> T.pack ptPath) $
        parsePivotTable (flip Prelude.lookup caches) bs
  
    tables <- forM tableIds $ \rId -> do
      fp <- lookupRelPath filePath sheetRels 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 sst t cur
    | t == "s" = do
      si <- vConverted "shared string"
      case sstItem sst si of
        Just xlTxt -> return $ xlsxTextToCellValue xlTxt
        Nothing -> fail "bad shared string index"
    | t == "inlineStr" =
      cur $/ element (addSmlNamespace "is") >=> fmap xlsxTextToCellValue . fromCursor
    | t == "str" = CellText <$> vConverted "string"
    | t == "n" = CellDouble <$> vConverted "double"
    | t == "b" = CellBool <$> vConverted "boolean"
    | t == "e" = CellError <$> vConverted "error"
    | otherwise = fail "bad cell value"
    where
      vConverted typeStr = do
        vContent <- cur $/ element (addSmlNamespace "v") >=> \c ->
          return (T.concat $ c $/ content)
        case fromAttrVal vContent of
          Right (val, _) -> return $ val
          _ -> fail $ "bad " ++ typeStr ++ " cell value"
  
  -- | Get xml cursor from the specified file inside the zip archive.
  xmlCursorOptional :: Zip.Archive -> FilePath -> Parser (Maybe Cursor)
  xmlCursorOptional ar fname =
      (Just <$> xmlCursorRequired ar fname) `catchError` missingToNothing
    where
      missingToNothing :: ParseError -> Either ParseError (Maybe a)
      missingToNothing (MissingFile _) = return Nothing
      missingToNothing other           = throwError other
  
  -- | Get xml cursor from the given file, failing with MissingFile if not found.
  xmlCursorRequired :: Zip.Archive -> FilePath -> Parser Cursor
  xmlCursorRequired ar fname = do
      entry <- note (MissingFile fname) $ Zip.findEntryByPath fname ar
      cur <- left (\ex -> InvalidFile fname (T.pack $ show ex)) $ parseLBS def (Zip.fromEntry entry)
      return $ fromDocument cur
  
  fromFileCursorDef ::
       FromCursor a => Zip.Archive -> FilePath -> Text -> a -> Parser a
  fromFileCursorDef x fp contentsDescr defVal = do
    mCur <- xmlCursorOptional x fp
    case mCur of
      Just cur ->
        headErr (InvalidFile fp $ "Couldn't parse " <> contentsDescr) $ fromCursor cur
      Nothing -> return defVal
  
  fromFileCursor :: FromCursor a => Zip.Archive -> FilePath -> Text -> Parser a
  fromFileCursor x fp contentsDescr = do
    cur <- xmlCursorRequired x fp
    headErr (InvalidFile fp $ "Couldn't parse " <> contentsDescr) $ fromCursor cur
  
  -- | Get shared string table
  getSharedStrings  :: Zip.Archive -> Parser SharedStringTable
  getSharedStrings x =
    fromFileCursorDef x "xl/sharedStrings.xml" "shared strings" sstEmpty
  
  getContentTypes :: Zip.Archive -> Parser ContentTypes
  getContentTypes x = fromFileCursor x "[Content_Types].xml" "content types"
  
  getStyles :: Zip.Archive -> Styles
  getStyles ar = case Zip.fromEntry <$> Zip.findEntryByPath "xl/styles.xml" ar of
    Nothing  -> Styles L.empty
    Just xml -> Styles xml
  
  getComments :: Zip.Archive -> Maybe FilePath -> FilePath -> Parser (Maybe CommentTable)
  getComments ar drp fp = do
      mCurComments <- xmlCursorOptional ar fp
      mCurDr <- maybe (return Nothing) (xmlCursorOptional ar) drp
      return (liftA2 hide (hidden <$> mCurDr) . listToMaybe . fromCursor =<< mCurComments)
    where
      hide refs (CommentTable m) = CommentTable $ foldl' hideComment m refs
      hideComment m r = M.adjust (\c->c{_commentVisible = False}) r m
      v nm = Name nm (Just "urn:schemas-microsoft-com:vml") Nothing
      x nm = Name nm (Just "urn:schemas-microsoft-com:office:excel") Nothing
      hidden :: Cursor -> [CellRef]
      hidden cur = cur $/ checkElement visibleShape &/
                   element (x"ClientData") >=> shapeCellRef
      visibleShape Element{..} = elementName ==  (v"shape") &&
          maybe False (any ("visibility:hidden"==) . T.split (==';')) (M.lookup "style" elementAttributes)
      shapeCellRef :: Cursor -> [CellRef]
      shapeCellRef c = do
          r0 <- c $/ element (x"Row") &/ content >=> decimal
          c0 <- c $/ element (x"Column") &/ content >=> decimal
          return $ singleCellRef (r0 + 1, c0 + 1)
  
  getCustomProperties :: Zip.Archive -> Parser CustomProperties
  getCustomProperties ar =
    fromFileCursorDef ar "docProps/custom.xml" "custom properties" CustomProperties.empty
  
  getDrawing :: Zip.Archive -> ContentTypes ->  FilePath -> Parser Drawing
  getDrawing ar contentTypes fp = do
      cur <- xmlCursorRequired ar 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 rels uAnch =
        case uAnch ^. anchObject of
          Picture {..} -> do
            let mRefId = _picBlipFill ^. bfpImageInfo
            mFI <- lookupFI rels mRefId
            let pic' =
                  Picture
                  { _picMacro = _picMacro
                  , _picPublished = _picPublished
                  , _picNonVisual = _picNonVisual
                  , _picBlipFill = (_picBlipFill & bfpImageInfo .~ mFI)
                  , _picShapeProperties = _picShapeProperties
                  }
            return uAnch {_anchObject = pic'}
          Graphic nv rId tr -> do
            chartPath <- lookupRelPath fp rels rId
            chart <- readChart ar chartPath
            return uAnch {_anchObject = Graphic nv chart tr}
      lookupFI _ Nothing = return Nothing
      lookupFI rels (Just rId) = do
        path <- lookupRelPath fp rels 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 p = fromMaybe p $ stripPrefix "xl/media/" p
  
  readChart :: Zip.Archive -> FilePath -> Parser ChartSpace
  readChart ar path = fromFileCursor ar path "chart"
  
  -- | readWorkbook pulls the names of the sheets and the defined names
  readWorkbook :: Zip.Archive -> Parser ([WorksheetFile], DefinedNames, Caches, DateBase)
  readWorkbook ar = do
    let wbPath = "xl/workbook.xml"
    cur <- xmlCursorRequired ar wbPath
    wbRels <- getRels ar wbPath
    -- Specification says the 'name' is required.
    let mkDefinedName :: Cursor -> [(Text, Maybe Text, Text)]
        mkDefinedName c =
          return
            ( headNote "Missing name attribute" $ attribute "name" c
            , listToMaybe $ attribute "localSheetId" c
            , T.concat $ c $/ content)
        names =
          cur $/ element (addSmlNamespace "definedNames") &/ element (addSmlNamespace "definedName") >=>
          mkDefinedName
    sheets <-
      sequence $
      cur $/ element (addSmlNamespace "sheets") &/ element (addSmlNamespace "sheet") >=>
      liftM4 (worksheetFile wbPath wbRels) <$> attribute "name" <*> fromAttribute "sheetId" <*> fromAttributeDef "state" def <*>
      fromAttribute (odr "id")
    let cacheRefs =
          cur $/ element (addSmlNamespace "pivotCaches") &/ element (addSmlNamespace "pivotCache") >=>
          liftA2 (,) <$> fromAttribute "cacheId" <*> fromAttribute (odr "id")
    caches <-
      forM cacheRefs $ \(cacheId, rId) -> do
        path <- lookupRelPath wbPath wbRels 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 recId -> do
            cacheRels <- getRels ar path
            recsPath <- lookupRelPath path cacheRels recId
            rCur <- xmlCursorRequired ar recsPath
            let recs = rCur $/ element (addSmlNamespace "r") >=> \cur' ->
                  return $ cur' $/ anyElement >=> recordValueFromNode . node
            return $ fillCacheFieldsFromRecords fields0 recs
          Nothing ->
            return fields0
        return $ (cacheId, (sheet, ref, fields))
    let dateBase = bool DateBase1900 DateBase1904 . fromMaybe False . listToMaybe $
                   cur $/ element (addSmlNamespace "workbookPr") >=> fromAttribute "date1904"
    return (sheets, DefinedNames names, caches, dateBase)
  
  getTable :: Zip.Archive -> FilePath -> Parser Table
  getTable ar fp = do
    cur <- xmlCursorRequired ar fp
    headErr (InvalidFile fp "Couldn't parse drawing") (fromCursor cur)
  
  worksheetFile :: FilePath -> Relationships -> Text -> Int -> SheetState -> RefId -> Parser WorksheetFile
  worksheetFile parentPath wbRels name sheetId visibility rId =
    WorksheetFile name sheetId visibility <$> lookupRelPath parentPath wbRels rId
  
  getRels :: Zip.Archive -> FilePath -> Parser Relationships
  getRels ar fp = do
      let (dir, file) = splitFileName fp
          relsPath = dir </> "_rels" </> file <.> "rels"
      c <- xmlCursorOptional ar 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 ('/' : name) = name
  logicalNameToZipItemName name = name
  
  lookupRelPath :: FilePath
                -> Relationships
                -> RefId
                -> Either ParseError FilePath
  lookupRelPath fp rels rId =
    logicalNameToZipItemName . relTarget <$> note (InvalidRef fp rId) (Relationships.lookup rId rels)
  