1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
) where
#ifdef USE_MICROLENS
import Lens.Micro
#else
import Control.Lens
#endif
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Map as M
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified StreamTests
import Text.XML
import Test.Tasty (defaultMain, testGroup)
import Test.Tasty.HUnit (testCase, (@=?))
import Test.Tasty.SmallCheck (testProperty)
import TestXlsx
import Codec.Xlsx
import Codec.Xlsx.Formatted
import AutoFilterTests
import Common
import CommonTests
import CondFmtTests
import Diff
import DrawingTests
import PivotTableTests
main :: IO ()
main = defaultMain $
testGroup "Tests"
[
testCase "write . read == id" $ do
let bs = fromXlsx testTime testXlsx
LB.writeFile "data-test.xlsx" bs
testXlsx @==? toXlsx (fromXlsx testTime testXlsx)
, testCase "write . fast-read == id" $ do
let bs = fromXlsx testTime testXlsx
LB.writeFile "data-test.xlsx" bs
testXlsx @==? toXlsxFast (fromXlsx testTime testXlsx)
, testCase "fromRows . toRows == id" $
testCellMap1 @=? fromRows (toRows testCellMap1)
, testCase "fromRight . parseStyleSheet . renderStyleSheet == id" $
testStyleSheet @==? fromRight (parseStyleSheet (renderStyleSheet testStyleSheet))
, testCase "correct shared strings parsing" $
[testSharedStringTable] @=? parseBS testStrings
, testCase "correct shared strings parsing: single underline" $
[withSingleUnderline testSharedStringTable] @=? parseBS testStringsWithSingleUnderline
, testCase "correct shared strings parsing: double underline" $
[withDoubleUnderline testSharedStringTable] @=? parseBS testStringsWithDoubleUnderline
, testCase "correct shared strings parsing even when one of the shared strings entry is just <t/>" $
[testSharedStringTableWithEmpty] @=? parseBS testStringsWithEmpty
, testCase "correct comments parsing" $
[testCommentTable] @=? parseBS testComments
, testCase "correct custom properties parsing" $
[testCustomProperties] @==? parseBS testCustomPropertiesXml
, testCase "proper results from `formatted`" $
testFormattedResult @==? testRunFormatted
, testCase "proper results from `formatWorkbook`" $
testFormatWorkbookResult @==? testFormatWorkbook
, testCase "formatted . toFormattedCells = id" $ do
let fmtd = formatted testFormattedCells minimalStyleSheet
testFormattedCells @==? toFormattedCells (formattedCellMap fmtd) (formattedMerges fmtd)
(formattedStyleSheet fmtd)
, testCase "proper results from `conditionallyFormatted`" $
testCondFormattedResult @==? testRunCondFormatted
, testCase "toXlsxEither: properly formatted" $
Right testXlsx @==? toXlsxEither (fromXlsx testTime testXlsx)
, testCase "toXlsxEither: invalid format" $
Left (InvalidZipArchive "Did not find end of central directory signature") @==? toXlsxEither "this is not a valid XLSX file"
, testCase "toXlsx: correct floats parsing (typed and untyped cells are floats by default)"
$ floatsParsingTests toXlsx
, testCase "toXlsxFast: correct floats parsing (typed and untyped cells are floats by default)"
$ floatsParsingTests toXlsxFast
, testGroup "Codec: sheet state visibility"
[ testGroup "toXlsxEitherFast"
[ testProperty "pure state == toXlsxEitherFast (fromXlsx (defXlsxWithState state))" $
\state ->
(Right (Just state) ==) $
fmap sheetStateOfDefXlsx $
toXlsxEitherFast . fromXlsx testTime $
defXlsxWithState state
, testCase "should otherwise infer visible state by default" $
Right (Just Visible) @=? (fmap sheetStateOfDefXlsx . toXlsxEitherFast) (fromXlsx testTime defXlsx)
]
, testGroup "toXlsxEither"
[ testProperty "pure state == toXlsxEither (fromXlsx (defXlsxWithState state))" $
\state ->
(Right (Just state) ==) $
fmap sheetStateOfDefXlsx $
toXlsxEither . fromXlsx testTime $
defXlsxWithState state
, testCase "should otherwise infer visible state by default" $
Right (Just Visible) @=? (fmap sheetStateOfDefXlsx . toXlsxEither) (fromXlsx testTime defXlsx)
]
]
, CommonTests.tests
, CondFmtTests.tests
, PivotTableTests.tests
, DrawingTests.tests
, AutoFilterTests.tests
, StreamTests.tests
]
floatsParsingTests :: (ByteString -> Xlsx) -> IO ()
floatsParsingTests parser = do
bs <- LB.readFile "data/floats.xlsx"
let xlsx = parser bs
parsedCells = maybe mempty (_wsCells . snd) $ listToMaybe $ xlsx ^. xlSheets
expectedCells = M.fromList
[ ((1,1), def & cellValue ?~ CellDouble 12.0)
, ((2,1), def & cellValue ?~ CellDouble 13.0)
, ((3,1), def & cellValue ?~ CellDouble 14.0 & cellStyle ?~ 1)
, ((4,1), def & cellValue ?~ CellDouble 15.0)
]
expectedCells @==? parsedCells
constSheetName :: Text
constSheetName = "sheet1"
defXlsx :: Xlsx
defXlsx = def & atSheet constSheetName ?~ def
defXlsxWithState :: SheetState -> Xlsx
defXlsxWithState state =
def & atSheet constSheetName ?~ (wsState .~ state $ def)
sheetStateOfDefXlsx :: Xlsx -> Maybe SheetState
sheetStateOfDefXlsx xlsx =
xlsx ^. atSheet constSheetName & mapped %~ _wsState
|
