content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes       #-}
  {-# LANGUAGE TupleSections     #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE CPP #-}
  
  module StreamTests
    ( tests
    ) where
  
  #ifdef USE_MICROLENS
  
  import Test.Tasty (TestName, TestTree, testGroup)
  tests :: TestTree
  tests = testGroup
    "I stubbed out the tests module for microlens \
     because it doesn't understand setOf. \
     Volunteers are welcome to fix this!"
      []
  #else
  
  import Control.Exception
  import Codec.Archive.Zip as Zip
  import Codec.Xlsx
  import Codec.Xlsx.Parser.Stream
  import Conduit ((.|))
  import qualified Conduit as C
  import Control.Lens hiding (indexed)
  import Control.Monad (void)
  import Data.Set.Lens
  import qualified Data.ByteString.Lazy as LB
  import qualified Data.ByteString as BS
  import Data.Map (Map)
  import qualified Data.Conduit.Combinators as C
  import qualified Data.Map as M
  import qualified Data.IntMap.Strict as IM
  import Data.Text (Text)
  import qualified Data.Text as Text
  import qualified Data.Vector as V
  import Diff
  import Test.Tasty (TestTree, testGroup)
  import Test.Tasty.HUnit (testCase)
  import TestXlsx
  import qualified Codec.Xlsx.Writer.Stream as SW
  import qualified Codec.Xlsx.Writer.Internal.Stream as SW
  import Control.Monad (void)
  import Control.Monad.State.Lazy
  import Test.Tasty.SmallCheck
  import Test.SmallCheck.Series.Instances ()
  import qualified Data.Set as Set
  import Data.Set (Set)
  import Text.Printf
  import Data.Conduit
  import Control.Arrow ((&&&))
  import Data.Maybe (fromJust)
  
  tshow :: Show a => a -> Text
  tshow = Text.pack . show
  
  toBs :: Xlsx -> BS.ByteString
  toBs = LB.toStrict . fromXlsx testTime
  
  tests :: TestTree
  tests =
    testGroup "Stream tests"
      [
        testGroup "Writer/shared strings"
        [ testProperty "Input same as the output" sharedStringInputSameAsOutput
        , testProperty "Set of input texts is same as map length" sharedStringInputTextsIsSameAsMapLength
        , testProperty "Set of input texts is as value set length" sharedStringInputTextsIsSameAsValueSetLength
        ],
  
        testGroup "Reader/shared strings"
        [ testCase "Can parse RichText values" richCellTextIsParsed
        ],
  
  
        testGroup "Reader/Writer"
        [ testCase "Write as stream, see if memory based implementation can read it" $ readWrite simpleWorkbook
        , testCase "Write as stream, see if memory based implementation can read it" $ readWrite simpleWorkbookRow
        , testCase "Test a small workbook which has a fullblown square" $ readWrite smallWorkbook
        , testCase "Test a big workbook as a full square which caused issues with zipstream \
                   The buffer of zipstream maybe 1kb, this workbook is big enough \
                   to be more than that. \
                   So if this encodes/decodes we know we can handle those sizes. \
                   In some older version the bytestring got cut off resulting in a corrupt xlsx file"
                    $ readWrite bigWorkbook
        , testCase "Test a workbook containing multiple sheets"
          $ readWriteMultipleSheets multipleSheetsWorkbook
        -- , testCase "Write as stream, see if memory based implementation can read it" $ readWrite testXlsx
        -- TODO forall SheetItem write that can be read
        ],
  
        testGroup "Reader/inline strings"
        [ testCase "Can parse row with inline strings" inlineStringsAreParsed
        ],
  
        testGroup "Reader/floats parsing"
        [ testCase "Can parse untyped values as floats" untypedCellsAreParsedAsFloats
        ]
      ]
  
  readWrite :: Xlsx -> IO ()
  readWrite input = do
    BS.writeFile "testinput.xlsx" (toBs input)
    items <- runXlsxM "testinput.xlsx" $ collectItemsIdentifier . fromJust =<< makeIdentifierFromName "Sheet1"
    bs <- runConduitRes $ void (SW.writeXlsx SW.defaultSettings $ C.yieldMany items) .| C.foldC
    case toXlsxEither $ LB.fromStrict bs of
      Right result  ->
        input @==?  result
      Left x -> do
        throwIO x
  
  readWriteMultipleSheets :: Xlsx -> IO ()
  readWriteMultipleSheets input = do
    BS.writeFile "testinput.xlsx" $ toBs input
    sheetsAndConduits <- runXlsxM "testinput.xlsx" $ do
      sheets <- reverse . _wiSheets <$> getWorkbookInfo
      let sheetCount = length sheets
      let sheetNamesAndStates = map (sheetInfoName &&& sheetInfoState) sheets
      sheetConduits <- map C.yieldMany
        <$> mapM (collectItemsIdentifier . getSheetIdentifier) sheets
      pure $ zip sheetNamesAndStates sheetConduits
  
    bs <- runConduitRes $ void (SW.writeXlsxWithConfig $ SW.defWriteXlsxConfig & SW.setNameInfosAndConduits sheetsAndConduits) .| C.foldC
    case toXlsxEither $ LB.fromStrict bs of
      Right result  -> input @==? result
      Left x -> throwIO x
  
  -- test if the input text is also the result (a property we use for convenience)
  sharedStringInputSameAsOutput :: Text -> Either String String
  sharedStringInputSameAsOutput someText =
    if someText  == out then Right msg  else Left msg
    where
      out = fst $ evalState (SW.upsertSharedString someText) SW.initialSharedString
      msg = printf "'%s' = '%s'" (Text.unpack out) (Text.unpack someText)
  
  -- test if unique strings actually get set in the map as keys
  sharedStringInputTextsIsSameAsMapLength :: [Text] -> Bool
  sharedStringInputTextsIsSameAsMapLength someTexts =
      length result == length unqTexts
    where
     result  :: Map Text Int
     result = view SW.string_map $ traverse SW.upsertSharedString someTexts `execState` SW.initialSharedString
     unqTexts :: Set Text
     unqTexts = Set.fromList someTexts
  
  -- test for every unique string we get a unique number
  sharedStringInputTextsIsSameAsValueSetLength :: [Text] -> Bool
  sharedStringInputTextsIsSameAsValueSetLength someTexts =
      length result == length unqTexts
    where
     result  :: Set Int
     result = setOf (SW.string_map . traversed) $ traverse SW.upsertSharedString someTexts `execState` SW.initialSharedString
     unqTexts :: Set Text
     unqTexts = Set.fromList someTexts
  
  -- can we do xx
  simpleWorkbook :: Xlsx
  simpleWorkbook = def & atSheet "Sheet1" ?~ sheet
    where
      sheet = toWs [ ((RowIndex 1, ColumnIndex 1), a1)
                   , ((RowIndex 1, ColumnIndex 2), cellValue ?~ CellText "text at B1 Sheet1" $ def) ]
  
  a1 :: Cell
  a1 = cellValue ?~ CellText "text at A1 Sheet1" $ cellStyle ?~ 1 $ def
  
  -- can we do x
  --           x
  simpleWorkbookRow :: Xlsx
  simpleWorkbookRow = def & atSheet "Sheet1" ?~ sheet
    where
      sheet = toWs [ ((RowIndex 1, ColumnIndex 1), a1)
                   , ((RowIndex 2, ColumnIndex 1), cellValue ?~ CellText "text at A2 Sheet1" $ def) ]
  
  toWs :: [((RowIndex, ColumnIndex), Cell)] -> Worksheet
  toWs x = set wsCells (M.fromList x) def
  
  -- can we do xxx
  --           xxx
  --           .
  --           .
  smallWorkbook :: Xlsx
  smallWorkbook = def & atSheet "Sheet1" ?~ sheet
    where
      sheet = toWs $ [1..2] >>= \row ->
                    [((row,1), a1)
                    , ((row,2), def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1"))
                    , ((row,3), def & cellValue ?~ CellText "text at C1 Sheet1")
                    , ((row,4), def & cellValue ?~ CellDouble (0.2 + 0.1))
                    , ((row,5), def & cellValue ?~ CellBool False)
                    ]
  --    sheets = [("Sheet1" , toWs $ [1..2] >>= \row ->
  --        [ ((RowIndex row, ColumnIndex 1), a1)
  --        , ((RowIndex row, ColumnIndex 2),
  --            def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1"))
  --        , ((RowIndex row, ColumnIndex 3),
  --            def & cellValue ?~ CellText "text at C1 Sheet1")
  --        , ((RowIndex row, ColumnIndex 4),
  --            def & cellValue ?~ CellDouble (0.2 + 0.1))
  --        , ((RowIndex row, ColumnIndex 5),
  --            def & cellValue ?~ CellBool False)
  --        ]
  --      )]
  
  bigWorkbook :: Xlsx
  bigWorkbook = def & atSheet "Sheet1" ?~ sheet
    where
      sheet = toWs $ [1..512] >>= \row ->
                    [((row,1), a1)
                    ,((row,2), def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1"))
                    ,((row,3), def & cellValue ?~ CellText "text at C1 Sheet1")
                    ]
  --    sheets = [("Sheet1" , toWs $ [1..512] >>= \row ->
  --        [((RowIndex row, ColumnIndex 1), a1)
  --        ,((RowIndex row, ColumnIndex 2),
  --            def & cellValue ?~ CellText ("text at B"<> tshow row <> " Sheet1"))
  --        ,((RowIndex row, ColumnIndex 3),
  --            def & cellValue ?~ CellText "text at C1 Sheet1")
  --        ]
  --      )]
  
  multipleSheetsWorkbook :: Xlsx
  multipleSheetsWorkbook = simpleWorkbook
      & atSheet "my Sheet 2" ?~ sheet2
      & atSheet "my Sheet 3" ?~ sheet3
    where
      sheet2 = toWs [ ((RowIndex 1, ColumnIndex 1), cellValue ?~ CellText "text at A1 Sheet2" $ def)
                   , ((RowIndex 1, ColumnIndex 2), cellValue ?~ CellText "text at B1 Sheet2" $ def) ]
      sheet3 = toWs [ ((RowIndex 1, ColumnIndex 1), cellValue ?~ CellText "text at A1 Sheet3" $ def)
                   , ((RowIndex 1, ColumnIndex 2), cellValue ?~ CellText "text at B1 Sheet3" $ def) ]
              & wsState .~ Hidden
  
  inlineStringsAreParsed :: IO ()
  inlineStringsAreParsed = do
    items <- runXlsxM "data/inline-strings.xlsx" $ collectItemsIdentifier . fromJust =<< makeIdentifierFromName "Sheet1"
    let expected =
          [ IM.fromList
              [ ( 1,
                  Cell
                    { _cellStyle = Nothing,
                      _cellValue = Just (CellText "My Inline String"),
                      _cellComment = Nothing,
                      _cellFormula = Nothing
                    }
                ),
                ( 2,
                  Cell
                    { _cellStyle = Nothing,
                      _cellValue = Just (CellText "two"),
                      _cellComment = Nothing,
                      _cellFormula = Nothing
                    }
                )
              ]
          ]
    expected @==? (items ^.. traversed . ri_cell_row)
  
  untypedCellsAreParsedAsFloats :: IO ()
  untypedCellsAreParsedAsFloats = do
    -- values in that file are under `General` cell-type and are not marked
    -- as numbers explicitly in `t` attribute.
    items <- runXlsxM "data/floats.xlsx" $ collectItemsIdentifier . fromJust =<< makeIdentifierFromName "Лист1"
    let expected =
          [ IM.fromList [ (1, def & cellValue ?~ CellDouble 12.0) ]
          , IM.fromList [ (1, def & cellValue ?~ CellDouble 13.0) ]
          -- cell below has explicit `Numeric` type, while others are all `General`,
          -- but sometimes excel does not add a `t="n"` attr even to numeric cells
          -- but it should be default as number in any cases if `t` is missing
          , IM.fromList [ (1, def & cellValue ?~ CellDouble 14.0 & cellStyle ?~ 1 ) ]
          , IM.fromList [ (1, def & cellValue ?~ CellDouble 15.0) ]
          ]
    expected @==? (_ri_cell_row <$> items)
  
  
  richCellTextIsParsed :: IO ()
  richCellTextIsParsed = do
    BS.writeFile "testinput.xlsx" (toBs richWorkbook)
    runXlsxM "testinput.xlsx" $ do
      sharedStrings <- getOrParseSharedStringss
      let result = Set.fromList $ V.toList sharedStrings
      liftIO $ expected @==? result
  
    where
      expected :: Set.Set Text
      expected = Set.fromList
        [ textA1
        , firstClauseB1 <> secondClauseB1
        , firstClauseB2 <> secondClauseB2
        ]
  
      textA1 = "Text at A1"
      firstClauseB1 = "First clause at B1;"
      firstClauseB2 = "First clause at B2;"
      secondClauseB1 = "Second clause at B1"
      secondClauseB2 = "Second clause at B2"
  
      richWorkbook :: Xlsx
      richWorkbook = def & atSheet "Sheet1" ?~ toWs
        [ ((RowIndex 1, ColumnIndex 1), cellValue ?~ CellText textA1 $ def)
        , ((RowIndex 2, ColumnIndex 1), cellValue ?~ cellRich firstClauseB1 secondClauseB1 $ def)
        , ((RowIndex 2, ColumnIndex 2), cellValue ?~ cellRich firstClauseB2 secondClauseB2 $ def)
        ]
  
  cellRich :: Text -> Text -> CellValue
  cellRich firstClause secondClause = CellRich
    [ RichTextRun
        { _richTextRunProperties = Just RunProperties
            { _runPropertiesBold = Nothing
            , _runPropertiesCharset = Just 1
            , _runPropertiesColor = Just Color
                { _colorAutomatic = Nothing
                , _colorARGB = Nothing
                , _colorTheme = Just 1
                , _colorTint = Nothing
                }
            , _runPropertiesCondense = Nothing
            , _runPropertiesExtend = Nothing
            , _runPropertiesFontFamily = Just FontFamilySwiss
            , _runPropertiesItalic = Nothing
            , _runPropertiesOutline = Nothing
            , _runPropertiesFont = Just "Aptos Narrow"
            , _runPropertiesScheme = Nothing
            , _runPropertiesShadow = Nothing
            , _runPropertiesStrikeThrough = Nothing
            , _runPropertiesSize = Just 11.0
            , _runPropertiesUnderline = Nothing
            , _runPropertiesVertAlign = Nothing
            }
        , _richTextRunText = firstClause
        }
    , RichTextRun
        { _richTextRunProperties = Just RunProperties
            { _runPropertiesBold = Just True
            , _runPropertiesCharset = Just 1
            , _runPropertiesColor = Just Color
                { _colorAutomatic = Nothing
                , _colorARGB = Just "FFFF0000"
                , _colorTheme = Nothing
                , _colorTint = Nothing
                }
            , _runPropertiesCondense = Nothing
            , _runPropertiesExtend = Nothing
            , _runPropertiesFontFamily = Just FontFamilySwiss
            , _runPropertiesItalic = Nothing
            , _runPropertiesOutline = Nothing
            , _runPropertiesFont = Just "Arial"
            , _runPropertiesScheme = Nothing
            , _runPropertiesShadow = Nothing
            , _runPropertiesStrikeThrough = Nothing
            , _runPropertiesSize = Just 8.0
            , _runPropertiesUnderline = Nothing
            , _runPropertiesVertAlign = Nothing
            }
        , _richTextRunText = secondClause
        }
    ]
  
  #endif
  