content: {-# LANGUAGE ConstraintKinds            #-}
  {-# LANGUAGE DeriveAnyClass             #-}
  {-# LANGUAGE DeriveGeneric              #-}
  {-# LANGUAGE DerivingStrategies         #-}
  {-# LANGUAGE FlexibleContexts           #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase                 #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE PackageImports             #-}
  {-# LANGUAGE RankNTypes                 #-}
  {-# LANGUAGE RecordWildCards            #-}
  {-# LANGUAGE ScopedTypeVariables        #-}
  {-# LANGUAGE StrictData                 #-}
  {-# LANGUAGE TemplateHaskell            #-}
  {-# LANGUAGE TypeApplications           #-}
  {-# LANGUAGE UndecidableInstances       #-}
  {-# LANGUAGE PatternSynonyms #-}
  
  -- |
  -- Module      : Codex.Xlsx.Parser.Stream
  -- Description : Stream parser for xlsx files
  -- Copyright   :
  --   (c) Adam, 2021
  --   (c) Supercede, 2021
  -- License     : MIT
  -- Stability   : experimental
  -- Portability : POSIX
  --
  -- Parse @.xlsx@ sheets in constant memory.
  --
  -- All actions on an xlsx file run inside the 'XlsxM' monad, and must
  -- be run with 'runXlsxM'. XlsxM is not a monad transformer, a design
  -- inherited from the "zip" package's ZipArchive monad.
  --
  -- Inside the XlsxM monad, you can stream 'SheetItem's (a row) from a
  -- particular sheet, using 'readSheetByIndex', which is callback-based and tied to IO.
  --
  module Codec.Xlsx.Parser.Stream
    ( XlsxM
    , runXlsxM
    , WorkbookInfo(..)
    , SheetInfo(..)
    , wiSheets
    , getOrParseSharedStringss
    , getWorkbookInfo
    , CellRow
    , readSheet
    , readSheetIdentifier
    , countRowsInSheet
    , countRowsInSheetIdentifier
    , collectItems
    , collectItemsIdentifier
    -- ** Index
    , SheetIndex
    , makeIndex
    , makeIndexFromName
    -- ** Identifier
    , SheetIdentifier
    , getSheetIdentifier
    , makeIdentifierFromName
    -- ** SheetItem
    , SheetItem(..)
    , si_sheet_index
    , si_row
    -- ** Row
    , Row(..)
    , ri_row_index
    , ri_cell_row
    -- * Errors
    , SheetErrors(..)
    , AddCellErrors(..)
    , CoordinateErrors(..)
    , TypeError(..)
    , WorkbookError(..)
    ) where
  
  import qualified "zip" Codec.Archive.Zip as Zip
  import Codec.Xlsx.Types.Cell
  import Codec.Xlsx.Types.Common
  import Codec.Xlsx.Types.Internal (RefId (..))
  import Codec.Xlsx.Types.Internal.Relationships (Relationship (..),
                                                  Relationships (..))
  import Conduit (PrimMonad, (.|))
  import qualified Conduit as C
  import qualified Data.Vector as V
  import Codec.Xlsx.LensCompat
  
  import Codec.Xlsx.Parser.Internal
  import Control.Monad
  import Control.Monad.Catch
  import Control.Monad.Except
  import Control.Monad.Reader
  import Control.Monad.State.Strict
  import Data.Bifunctor
  import Data.ByteString (ByteString)
  import qualified Data.ByteString as BS
  import Data.Conduit (ConduitT)
  import qualified Data.DList as DL
  import Data.Foldable
  import Data.IORef
  import qualified Data.IntMap.Strict as IntMap
  import qualified Data.Map.Strict as M
  import Data.Text (Text)
  import qualified Data.Text as T
  import qualified Data.Text.Lazy as LT
  import qualified Data.Text.Lazy.Builder as TB
  import qualified Data.Text.Read as Read
  import Data.Traversable (for)
  import Data.XML.Types
  import GHC.Generics
  import Codec.Xlsx.Parser.Internal.Memoize
  
  import qualified Codec.Xlsx.Parser.Stream.HexpatInternal as HexpatInternal
  import Control.Monad.Base
  import Control.Monad.Trans.Control
  import Text.XML.Expat.Internal.IO as Hexpat
  import Text.XML.Expat.SAX as Hexpat
  import Codec.Xlsx.Types
  import Codec.Xlsx.Parser.Stream.SheetInfo
  import Codec.Xlsx.Parser.Stream.Row
  import Codec.Xlsx.Parser.Stream.SheetItem
  import Codec.Xlsx.Parser.Stream.SheetIdentifier
  import Codec.Xlsx.Parser.Stream.SheetIndex
  
  type SharedStringsMap = V.Vector Text
  
  -- | Type of the excel value
  --
  -- Note: Some values are untyped and rules of their type resolution are not known.
  -- They may be treated simply as strings as well as they may be context-dependent.
  -- By far we do not bother with it.
  data ExcelValueType
    = TS      -- ^ shared string
    | TStr    -- ^ either an inline string ("inlineStr") or a formula string ("str")
    | TN      -- ^ number
    | TB      -- ^ boolean
    | TE      -- ^ excell error, the sheet can contain error values, for example if =1/0, causes division by zero
    | Untyped -- ^ Not all values have types
    deriving stock (Generic, Show)
  
  -- | State for parsing sheets
  data ParserState = MkParserState
    { _ps_row             :: ~CellRow        -- ^ Current row
    , _ps_cell_row_index  :: RowIndex        -- ^ Current row number
    , _ps_cell_col_index  :: ColumnIndex     -- ^ Current column number
    , _ps_cell_style      :: Maybe Int
    , _ps_is_in_val       :: Bool            -- ^ Flag for indexing wheter the parser is in value or not
    , _ps_shared_strings  :: SharedStringsMap -- ^ Shared string map
    , _ps_type            :: ExcelValueType  -- ^ The last detected value type
  
    , _ps_text_buf        :: Text
    -- ^ for hexpat only, which can break up char data into multiple events
    , _ps_worksheet_ended :: Bool
    -- ^ For hexpat only, which can throw errors right at the end of the sheet
    -- rather than ending gracefully.
    } deriving stock (Generic, Show)
  makeLenses 'MkParserState
  
  -- | State for parsing shared strings
  data SharedStringsState = MkSharedStringsState
    { _ss_string :: TB.Builder -- ^ String we are parsing
    -- TODO: At the moment SharedStrings can be used only to create CellText values.
    -- We should add support for CellRich values.
    , _ss_list   :: DL.DList Text -- ^ list of shared strings
    } deriving stock (Generic, Show)
  makeLenses 'MkSharedStringsState
  
  type HasParserState = MonadState ParserState
  type HasSharedStringsState = MonadState SharedStringsState
  
  -- | Information about the workbook contained in xl/workbook.xml
  -- (currently a subset)
  data WorkbookInfo = WorkbookInfo
    { _wiSheets :: [SheetInfo]
    } deriving Show
  makeLenses 'WorkbookInfo
  
  data XlsxMState = MkXlsxMState
    { _xs_shared_strings :: Memoized (V.Vector Text)
    , _xs_workbook_info  :: Memoized WorkbookInfo
    , _xs_relationships  :: Memoized Relationships
    }
  
  newtype XlsxM a = XlsxM {_unXlsxM :: ReaderT XlsxMState Zip.ZipArchive a}
    deriving newtype
      ( Functor,
        Applicative,
        Monad,
        MonadIO,
        MonadCatch,
        MonadMask,
        MonadThrow,
        MonadReader XlsxMState,
        MonadBase IO,
        MonadBaseControl IO
      )
  
  -- | Initial parsing state
  initialParserState :: ParserState
  initialParserState = MkParserState
    { _ps_row             = mempty
    , _ps_cell_row_index  = 0
    , _ps_cell_col_index  = 0
    , _ps_is_in_val       = False
    , _ps_shared_strings  = mempty
    , _ps_type            = Untyped
    , _ps_text_buf        = mempty
    , _ps_worksheet_ended = False
    , _ps_cell_style      = Nothing
    }
  
  -- | Initial parsing state
  initialSharedStrings :: SharedStringsState
  initialSharedStrings = MkSharedStringsState
    { _ss_string = mempty
    , _ss_list = mempty
    }
  
  -- | Parse shared string entry from xml event and return it once
  -- we've reached the end of given element
  {-# SCC parseSharedStrings #-}
  parseSharedStrings
    :: ( MonadThrow m
       , HasSharedStringsState m
       )
    => HexpatEvent -> m (Maybe Text)
  parseSharedStrings = \case
    -- TODO: Add parsing of text styles to further create CellRich values.
    StartElement "si" _ -> Nothing <$ (ss_string .= mempty)
    EndElement "si"     -> Just . LT.toStrict . TB.toLazyText <$> gets _ss_string
    CharacterData txt   -> Nothing <$ (ss_string <>= TB.fromText txt)
    _                   -> pure Nothing
  
  -- | Run a series of actions on an Xlsx file
  runXlsxM :: MonadIO m => FilePath -> XlsxM a -> m a
  runXlsxM xlsxFile (XlsxM act) = liftIO $ do
    -- TODO: don't run the withArchive multiple times but use liftWith or runInIO instead
    _xs_workbook_info  <- memoizeRef (Zip.withArchive xlsxFile readWorkbookInfo)
    _xs_relationships  <- memoizeRef (Zip.withArchive xlsxFile readWorkbookRelationships)
    _xs_shared_strings <- memoizeRef (Zip.withArchive xlsxFile parseSharedStringss)
    Zip.withArchive xlsxFile $ runReaderT act $ MkXlsxMState{..}
  
  liftZip :: Zip.ZipArchive a -> XlsxM a
  liftZip = XlsxM . ReaderT . const
  
  parseSharedStringss :: Zip.ZipArchive (V.Vector Text)
  parseSharedStringss = do
        sharedStrsSel <- Zip.mkEntrySelector "xl/sharedStrings.xml"
        hasSharedStrs <- Zip.doesEntryExist sharedStrsSel
        if not hasSharedStrs
          then pure mempty
          else do
            let state0 = initialSharedStrings
            byteSrc <- Zip.getEntrySource sharedStrsSel
            st <- liftIO $ runExpat state0 byteSrc $ \evs -> forM_ evs $ \ev -> do
              mTxt <- parseSharedStrings ev
              for_ mTxt $ \txt ->
                ss_list %= (`DL.snoc` txt)
            pure $ V.fromList $ DL.toList $ _ss_list st
  
  {-# SCC getOrParseSharedStringss #-}
  getOrParseSharedStringss :: XlsxM (V.Vector Text)
  getOrParseSharedStringss = runMemoized =<< asks _xs_shared_strings
  
  readWorkbookInfo :: Zip.ZipArchive WorkbookInfo
  readWorkbookInfo = do
     sel <- Zip.mkEntrySelector "xl/workbook.xml"
     src <- Zip.getEntrySource sel
     sheetIndexRef <- liftIO $ newIORef 0
     sheets <- liftIO $ runExpat [] src $ \evs -> forM_ evs $ \case
       StartElement ("sheet" :: ByteString) attrs -> do
         nm <- lookupBy "name" attrs
         sheetId <- lookupBy "sheetId" attrs
         rId <- lookupBy "r:id" attrs
         sheetState <- case lookup "state" attrs of
           Nothing -> pure Visible -- default to visible if not found
           Just ss -> case ss of
             "visible"  -> pure Visible
             "hidden"   -> pure Hidden
             "veryHidden" -> pure VeryHidden
             _          -> throwM $ InvalidSheetState ss
         sheetNum <- either (throwM . ParseDecimalError sheetId) pure $ eitherDecimal sheetId
         sheetIndex <- liftIO $ atomicModifyIORef' sheetIndexRef $ \i -> (succ i, i)
         let info = MkSheetInfo nm (RefId rId) sheetNum sheetIndex sheetState
         modify' (info :)
       _ -> pure ()
     pure $ WorkbookInfo sheets
  
  lookupBy :: MonadThrow m => ByteString -> [(ByteString, Text)] -> m Text
  lookupBy fields attrs = maybe (throwM $ LookupError attrs fields) pure $ lookup fields attrs
  
  -- | Returns information about the workbook, found in
  -- xl/workbook.xml. The result is cached so the XML will only be
  -- decompressed and parsed once inside a larger XlsxM action.
  getWorkbookInfo :: XlsxM WorkbookInfo
  getWorkbookInfo = runMemoized =<< asks _xs_workbook_info
  
  readWorkbookRelationships :: Zip.ZipArchive Relationships
  readWorkbookRelationships = do
     sel <- Zip.mkEntrySelector "xl/_rels/workbook.xml.rels"
     src <- Zip.getEntrySource sel
     liftIO $ fmap Relationships $ runExpat mempty src $ \evs -> forM_ evs $ \case
       StartElement ("Relationship" :: ByteString) attrs -> do
         rId <- lookupBy "Id" attrs
         rTarget <- lookupBy "Target" attrs
         rType <- lookupBy "Type" attrs
         modify' $ M.insert (RefId rId) $
           Relationship { relType = rType,
                          relTarget = T.unpack rTarget
                         }
       _ -> pure ()
  
  -- | Gets relationships for the workbook (this means the filenames in
  -- the relationships map are relative to "xl/" base path within the
  -- zip file.
  --
  -- The relationships xml file will only be parsed once when called
  -- multiple times within a larger XlsxM action.
  getWorkbookRelationships :: XlsxM Relationships
  getWorkbookRelationships = runMemoized =<< asks _xs_relationships
  
  type HexpatEvent = SAXEvent ByteString Text
  
  relIdToEntrySelector :: RefId -> XlsxM (Maybe Zip.EntrySelector)
  relIdToEntrySelector rid = do
    Relationships rels <- getWorkbookRelationships
    for (M.lookup rid rels) $ \rel -> do
      Zip.mkEntrySelector $ "xl/" <> relTarget rel
  
  -- If the given sheet number exists, returns Just a conduit source of the stream
  -- of XML events in a particular sheet. Returns Nothing when the sheet doesn't
  -- exist.
  {-# SCC getSheetXmlSource #-}
  getSheetXmlSource ::
    (PrimMonad m, MonadThrow m, C.MonadResource m) =>
    SheetIdentifier ->
    XlsxM (Maybe (ConduitT () ByteString m ()))
  getSheetXmlSource (SheetIdentifier refId _sheetId) = do
    -- TODO: The Zip library may throw exceptions that aren't exposed from this
    -- module, so downstream library users would need to add the 'zip' package to
    -- handle them. Consider re-wrapping zip library exceptions, or just
    -- re-export them?
    mSheetSel <- relIdToEntrySelector refId
    sheetExists <- maybe (pure False) (liftZip . Zip.doesEntryExist) mSheetSel
    case mSheetSel of
      Just sheetSel
        | sheetExists ->
            Just <$> liftZip (Zip.getEntrySource sheetSel)
      _ -> pure Nothing
  
  {-# SCC runExpat #-}
  runExpat :: forall state tag text.
    (GenericXMLString tag, GenericXMLString text) =>
    state ->
    ConduitT () ByteString (C.ResourceT IO) () ->
    ([SAXEvent tag text] -> StateT state IO ()) ->
    IO state
  runExpat initialState byteSource handler = do
    -- Set up state
    ref <- newIORef initialState
    -- Set up parser and callbacks
    (parseChunk, _getLoc) <- Hexpat.hexpatNewParser Nothing Nothing False
    let noExtra _ offset = pure ((), offset)
        {-# SCC processChunk #-}
        {-# INLINE processChunk #-}
        processChunk isFinalChunk chunk = do
          (buf, len, mError) <- parseChunk chunk isFinalChunk
          saxen <- HexpatInternal.parseBuf buf len noExtra
          case mError of
            Just err -> error $ "expat error: " <> show err
            Nothing -> do
              state0 <- liftIO $ readIORef ref
              state1 <-
                {-# SCC "runExpat_runStateT_call" #-}
                execStateT (handler $ map fst saxen) state0
              writeIORef ref state1
    C.runConduitRes $
      byteSource .|
      C.awaitForever (liftIO . processChunk False)
    processChunk True BS.empty
    readIORef ref
  
  runExpatForSheet ::
    ParserState ->
    ConduitT () ByteString (C.ResourceT IO) () ->
    (Row -> IO ()) ->
    XlsxM ()
  runExpatForSheet initState byteSource inner =
    void $ liftIO $ runExpat initState byteSource handler
    where
      handler evs = forM_ evs $ \ev -> do
        parseRes <- runExceptT $ matchHexpatEvent ev
        case parseRes of
          Left err -> throwM err
          Right (Just cellRow)
            | not (IntMap.null cellRow) -> do
                rowNum <- use ps_cell_row_index
                liftIO $ inner $ MkRow rowNum cellRow
          _ -> pure ()
  
  -- | this will collect the sheetitems in a list.
  --   useful for cases were memory is of no concern but a sheetitem
  --   type in a list is needed.
  {-# DEPRECATED collectItems "prefer to use collectItemsIdentifier, see issue #193" #-}
  collectItems ::
    SheetIndex ->
    XlsxM [SheetItem]
  collectItems (MkSheetIndex sheetId) = makeIdentifierFromId sheetId >>= \case
    Nothing -> pure []
    Just identifier -> fmap (MkSheetItem sheetId) <$> collectItemsIdentifier identifier
  
  -- | this will collect the rows in a list.
  --   useful for cases were memory is of no concern but a row
  --   type in a list is needed.
  collectItemsIdentifier ::
    SheetIdentifier ->
    XlsxM [Row]
  collectItemsIdentifier sheetIdentifier = do
   res <- liftIO $ newIORef []
   void $ readSheetIdentifier sheetIdentifier $ \item ->
     liftIO (modifyIORef' res (item :))
   fmap reverse $ liftIO $ readIORef res
  
  -- | Look up the index of a case insensitive sheet name
  {-# DEPRECATED makeIndexFromName "prefer to use makeIdentifierFromName" #-}
  makeIndexFromName :: Text -> XlsxM (Maybe SheetIndex)
  makeIndexFromName sheetName = do
    fmap (makeIndex . siSheetId) <$> makeIdentifierFromName sheetName
  
  -- | Look up the identifier of a case insensitive sheet name
  makeIdentifierFromName :: Text -> XlsxM (Maybe SheetIdentifier)
  makeIdentifierFromName sheetName = do
    wi <- getWorkbookInfo
    -- The Excel UI does not allow a user to create two sheets whose
    -- names differ only in alphabetic case (at least for ascii...)
    let sheetNameCI = T.toLower sheetName
        findRes :: Maybe SheetInfo
        findRes = find ((== sheetNameCI) . T.toLower . sheetInfoName) $ _wiSheets wi
    pure $ getSheetIdentifier <$> findRes
  
  -- | Look up the identifier of a sheet id. Not for exporting since it is somewhat
  -- nonsensical if you do not have the sheet id.
  makeIdentifierFromId :: Int -> XlsxM (Maybe SheetIdentifier)
  makeIdentifierFromId sheetId = do
    WorkbookInfo sheets <- getWorkbookInfo
    pure $ getSheetIdentifier <$> find ((== sheetId) . sheetInfoSheetId) sheets
  
  {-# DEPRECATED readSheet "prefer to use readSheetIdentifier" #-}
  readSheet ::
    SheetIndex ->
    -- | Function to consume the sheet's rows
    (SheetItem -> IO ()) ->
    -- | Returns False if sheet doesn't exist, or True otherwise
    XlsxM Bool
  readSheet (MkSheetIndex sheetId) inner = makeIdentifierFromId sheetId >>= \case
      Nothing -> pure False
      Just identifier -> readSheetIdentifier identifier (inner . MkSheetItem sheetId)
  
  readSheetIdentifier ::
    SheetIdentifier ->
    -- | Function to consume the sheet's rows
    (Row -> IO ()) ->
    -- | Returns False if sheet doesn't exist, or True otherwise
    XlsxM Bool
  readSheetIdentifier identifier inner = do
    mSrc :: Maybe (ConduitT () ByteString (C.ResourceT IO) ()) <- getSheetXmlSource identifier
    let
    case mSrc of
      Nothing -> pure False
      Just sourceSheetXml -> do
        sharedStrs <- getOrParseSharedStringss
        let sheetState0 = initialParserState
              & ps_shared_strings .~ sharedStrs
        runExpatForSheet sheetState0 sourceSheetXml inner
        pure True
  
  -- | Returns number of rows in the given sheet (identified by the
  -- sheet's ID, AKA the sheetId attribute, AKA 'sheetInfoSheetId'), or Nothing
  -- if the sheet does not exist. Does not perform a full parse of the
  -- XML into 'SheetItem's, so it should be more efficient than counting
  -- via 'readSheetByIndex'.
  {-# DEPRECATED countRowsInSheet "prefer to use countRowsInSheetIdentifier" #-}
  countRowsInSheet :: SheetIndex -> XlsxM (Maybe Int)
  countRowsInSheet (MkSheetIndex sheetId) =
    makeIdentifierFromId sheetId >>= \case
      Nothing -> pure Nothing
      Just identifier -> countRowsInSheetIdentifier identifier
  
  -- | Returns number of rows in the given sheet or Nothing
  -- if the sheet does not exist. Does not perform a full parse of the
  -- XML into 'SheetItem's, so it should be more efficient than counting
  -- via 'readSheetByIndex'.
  countRowsInSheetIdentifier :: SheetIdentifier -> XlsxM (Maybe Int)
  countRowsInSheetIdentifier identifier = do
    mSrc :: Maybe (ConduitT () ByteString (C.ResourceT IO) ()) <-
      getSheetXmlSource identifier
    for mSrc $ \sourceSheetXml -> do
      liftIO $ runExpat @Int @ByteString @ByteString 0 sourceSheetXml $ \evs ->
        forM_ evs $ \case
          StartElement "row" _ -> modify' (+1)
          _                    -> pure ()
  
  -- | Return row from the state and empty it
  popRow :: HasParserState m => m CellRow
  popRow = do
    row <- use ps_row
    ps_row .= mempty
    pure row
  
  data AddCellErrors
    = ReadError -- ^ Could not read current cell value
        Text    -- ^ Original value
        String  -- ^ Error message
    | SharedStringsNotFound -- ^ Could not find string by index in shared string table
        Int                -- ^ Given index
        (V.Vector Text)      -- ^ Given shared strings to lookup in
    deriving Show
  
  -- | Parse the given value
  --
  -- If it's a string, we try to get it our of a shared string table
  {-# SCC parseValue #-}
  parseValue :: SharedStringsMap -> Text -> ExcelValueType -> Either AddCellErrors CellValue
  parseValue sstrings txt = \case
    TS -> do
      (idx, _) <- ReadError txt `first` Read.decimal @Int txt
      string <- maybe (Left $ SharedStringsNotFound idx sstrings) Right $ {-# SCC "sstrings_lookup_scc" #-}  (sstrings ^? ix idx)
      Right $ CellText string
    TStr -> pure $ CellText txt
    TN -> bimap (ReadError txt) (CellDouble . fst) $ Read.double txt
    TE -> bimap (ReadError txt) (CellError . fst) $ fromAttrVal txt
    TB | txt == "1" -> Right $ CellBool True
       | txt == "0" -> Right $ CellBool False
       | otherwise -> Left $ ReadError txt "Could not read Excel boolean value (expected 0 or 1)"
    Untyped -> Right (parseUntypedValue txt)
  
  -- TODO: some of the cells are untyped and we need to test whether
  -- they all are strings or something more complicated
  parseUntypedValue :: Text -> CellValue
  parseUntypedValue = CellText
  
  -- | Adds a cell to row in state monad
  {-# SCC addCellToRow #-}
  addCellToRow
    :: ( MonadError SheetErrors m
       , HasParserState m
       )
    => Text -> m ()
  addCellToRow txt = do
    st <- get
    style <- use ps_cell_style
    when (_ps_is_in_val st) $ do
      val <- liftEither $ first ParseCellError $ parseValue (_ps_shared_strings st) txt (_ps_type st)
      put $ st { _ps_row = IntMap.insert (unColumnIndex $ _ps_cell_col_index st)
                           (Cell { _cellStyle   = style
                                 , _cellValue   = Just val
                                 , _cellComment = Nothing
                                 , _cellFormula = Nothing
                                 }) $ _ps_row st}
  
  data SheetErrors
    = ParseCoordinateError CoordinateErrors -- ^ Error while parsing coordinates
    | ParseTypeError TypeError              -- ^ Error while parsing types
    | ParseCellError AddCellErrors          -- ^ Error while parsing cells
    | ParseStyleErrors StyleError
    | HexpatParseError Hexpat.XMLParseError
    deriving stock Show
    deriving anyclass Exception
  
  type SheetValue = (ByteString, Text)
  type SheetValues = [SheetValue]
  
  data CoordinateErrors
    = CoordinateNotFound SheetValues         -- ^ If the coordinate was not specified in "r" attribute
    | NoListElement SheetValue SheetValues   -- ^ If the value is empty for some reason
    | NoTextContent Content SheetValues      -- ^ If the value has something besides @ContentText@ inside
    | DecodeFailure Text SheetValues         -- ^ If malformed coordinate text was passed
    deriving stock Show
    deriving anyclass Exception
  
  data TypeError
    = TypeNotFound SheetValues
    | TypeNoListElement SheetValue SheetValues
    | UnkownType Text SheetValues
    | TypeNoTextContent Content SheetValues
    deriving Show
    deriving anyclass Exception
  
  data WorkbookError = LookupError { lookup_attrs :: [(ByteString, Text)], lookup_field :: ByteString }
                     | ParseDecimalError Text String
                     | InvalidSheetState Text
    deriving Show
    deriving anyclass Exception
  
  {-# SCC matchHexpatEvent #-}
  matchHexpatEvent ::
    ( MonadError SheetErrors m,
      HasParserState m
    ) =>
    HexpatEvent ->
    m (Maybe CellRow)
  matchHexpatEvent ev = case ev of
    CharacterData txt -> {-# SCC "handle_CharData" #-} do
      inVal <- use ps_is_in_val
      when inVal $
        {-# SCC "append_text_buf" #-} (ps_text_buf <>= txt)
      pure Nothing
    StartElement "c" attrs -> Nothing <$ (setCoord attrs *> setType attrs *> setStyle attrs)
    StartElement "is" _ -> Nothing <$ (ps_is_in_val .= True)
    EndElement "is" -> Nothing <$ finaliseCellValue
    StartElement "v" _ -> Nothing <$ (ps_is_in_val .= True)
    EndElement "v" -> Nothing <$ finaliseCellValue
    -- If beginning of row, empty the state and return nothing.
    -- We don't know if there is anything in the state, the user may have
    -- decided to <row> <row> (not closing). In any case it's the beginning of a new row
    -- so we clear the state.
    StartElement "row" _ -> Nothing <$ popRow
    -- If at the end of the row, we have collected the whole row into
    -- the current state. Empty the state and return the row.
    EndElement "row" -> Just <$> popRow
    StartElement "worksheet" _ -> ps_worksheet_ended .= False >> pure Nothing
    EndElement "worksheet" -> ps_worksheet_ended .= True >> pure Nothing
    -- Skip everything else, e.g. the formula elements <f>
    FailDocument err -> do
      -- this event is emitted at the end the xml stream (possibly
      -- because the xml files in xlsx archives don't end in a
      -- newline, but that's a guess), so we use state to determine if
      -- it's expected.
      finished <- use ps_worksheet_ended
      unless finished $
        throwError $ HexpatParseError err
      pure Nothing
    _ -> pure Nothing
  
  {-# INLINE finaliseCellValue #-}
  finaliseCellValue ::
    ( MonadError SheetErrors m, HasParserState m ) => m ()
  finaliseCellValue = do
    txt <- gets _ps_text_buf
    addCellToRow txt
    modify' $ \st ->
      st { _ps_is_in_val = False
         , _ps_text_buf = mempty
         }
  
  -- | Update state coordinates accordingly to @parseCoordinates@
  {-# SCC setCoord #-}
  setCoord
    :: ( MonadError SheetErrors m
       , HasParserState m
       )
    => SheetValues -> m ()
  setCoord list = do
    coordinates <- liftEither $ first ParseCoordinateError $ parseCoordinates list
    ps_cell_col_index .= (coordinates ^. _2)
    ps_cell_row_index .= (coordinates ^. _1)
  
  -- | Parse type from values and update state accordingly
  setType
    :: ( MonadError SheetErrors m
       , HasParserState m
   )
    => SheetValues -> m ()
  setType list = do
    type' <- liftEither $ first ParseTypeError $ parseType list
    ps_type .= type'
  
  -- | Find sheet value by its name
  findName :: ByteString -> SheetValues -> Maybe SheetValue
  findName name = find ((name ==) . fst)
  {-# INLINE findName #-}
  
  setStyle :: (MonadError SheetErrors m, HasParserState m) => SheetValues -> m ()
  setStyle list = do
    style <- liftEither $ first ParseStyleErrors $ parseStyle list
    ps_cell_style .= style
  
  data StyleError = InvalidStyleRef { seInput:: Text,  seErrorMsg :: String}
    deriving Show
  
  parseStyle :: SheetValues -> Either StyleError (Maybe Int)
  parseStyle list =
    case findName "s" list of
      Nothing -> pure Nothing
      Just (_nm, valTex) -> case Read.decimal valTex of
        Left err        -> Left (InvalidStyleRef valTex err)
        Right (i, _rem) -> pure $ Just i
  
  -- | Parse value type
  {-# SCC parseType #-}
  parseType :: SheetValues -> Either TypeError ExcelValueType
  parseType list =
    case findName "t" list of
      -- 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>
      Nothing -> Right TN
      Just (_nm, valText)->
        case valText of
          "n"         -> Right TN
          "s"         -> Right TS
           -- "Cell containing a formula string". Probably shouldn't be TStr..
          "str"       -> Right TStr
          "inlineStr" -> Right TStr
          "b"         -> Right TB
          "e"         -> Right TE
          other       -> Left $ UnkownType other list
  
  -- | Parse coordinates from a list of xml elements if such were found on "r" key
  {-# SCC parseCoordinates #-}
  parseCoordinates :: SheetValues -> Either CoordinateErrors (RowIndex, ColumnIndex)
  parseCoordinates list = do
    (_nm, valText) <- maybe (Left $ CoordinateNotFound list) Right $ findName "r" list
    maybe (Left $ DecodeFailure valText list) Right $ fromSingleCellRef $ CellRef valText
  