{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {- | QuickCheck properties for the SIMD CSV parser. Each property builds a fresh input on disk under @/tmp@, exercises 'DataFrame.IO.CSV.Fast.fastReadCsv' (or a variant), and asserts a property-level invariant. Temp files are cleaned up by the caller. The properties deliberately avoid depending on type-inference: every test cell starts with a letter so 'parseFromExamples' always lands on @Text@, which makes roundtrip comparison unambiguous. -} module Properties.Csv (tests) where import Control.Exception (try) import qualified Data.List as L import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.IO as TIO import qualified Data.Vector as V import DataFrame.IO.CSV (defaultReadOptions) import Data.Type.Equality (testEquality, (:~:) (Refl)) import DataFrame.IO.CSV.Fast (CsvParseError (..)) import qualified DataFrame.IO.CSV.Fast as D import DataFrame.Internal.Column (Column (..), materializePacked) import DataFrame.Internal.DataFrame ( DataFrame (..), columnIndices, columns, dataframeDimensions, ) import System.Directory (removeFile) import Test.QuickCheck import Test.QuickCheck.Monadic (PropertyM, assert, monadicIO, run) import Type.Reflection (typeRep) {- | A generator for a single CSV cell. Each cell starts with an ASCII letter (so type inference always picks 'Text') and may contain a small menagerie of special characters the parser must escape correctly. -} newtype Cell = Cell {unCell :: T.Text} deriving (Eq, Show) instance Arbitrary Cell where arbitrary = do leading <- elements "abcdefghij" rest <- listOf (elements "abcdef,\n\"\r ") pure (Cell (T.pack (leading : rest))) shrink (Cell t) | T.null t || T.length t == 1 = [] | otherwise = [Cell (T.take (T.length t - 1) t)] {- | Like 'Cell' but guaranteed to contain neither @\\n@ nor @\\r@. Used by properties that diff across line-ending dialects, where embedded line breaks become part of the data under CRLF transform and break the otherwise-clean invariant. -} newtype SingleLineCell = SingleLineCell {unSingleLineCell :: T.Text} deriving (Eq, Show) instance Arbitrary SingleLineCell where arbitrary = do leading <- elements "abcdefghij" rest <- listOf (elements "abcdef, \"") pure (SingleLineCell (T.pack (leading : rest))) shrink (SingleLineCell t) | T.null t || T.length t == 1 = [] | otherwise = [SingleLineCell (T.take (T.length t - 1) t)] -- | A generator for a non-empty list of ASCII column names, unique. newtype ColumnNames = ColumnNames {unColumnNames :: [T.Text]} deriving (Eq, Show) instance Arbitrary ColumnNames where arbitrary = do n <- chooseInt (1, 4) pure (ColumnNames [T.pack ('c' : show i) | i <- [0 .. n - 1]]) shrink (ColumnNames ns) | length ns <= 1 = [] | otherwise = [ColumnNames (init ns)] {- | RFC 4180 cell encoding: wrap a field in @"@ and double embedded quotes when the cell contains the separator, a line break, or a quote. -} encodeCell :: Char -> T.Text -> T.Text encodeCell sep t | T.any needsQuote t = T.concat ["\"", T.replace "\"" "\"\"" t, "\""] | otherwise = t where needsQuote c = c == sep || c == '\n' || c == '\r' || c == '"' {- | Encode a grid @[[cell]]@ (rows of cells) as an RFC 4180 CSV. The first row is written as the header, followed by one line per data row. Always uses @\\n@ as the line terminator; callers that need CRLF can transform the output themselves. -} encodeCsv :: Char -> [T.Text] -> [[T.Text]] -> T.Text encodeCsv sep header rows = T.unlines (encodeRow header : map encodeRow rows) where encodeRow = T.intercalate (T.singleton sep) . map (encodeCell sep) {- | Pull the raw 'Text' values of the named column out of a DataFrame. Fails the property if the column is missing or is not a 'Text' column (which would signal a type-inference accident — the cell generator is designed to avoid that). -} columnAsText :: T.Text -> DataFrame -> Maybe [T.Text] columnAsText name df = do idx <- M.lookup name (columnIndices df) col <- columns df V.!? idx case materializePacked col of BoxedColumn _ (vec :: V.Vector a) -> case testEquality (typeRep @a) (typeRep @T.Text) of Just Refl -> Just (V.toList vec) Nothing -> Nothing UnboxedColumn{} -> Nothing PackedText{} -> Nothing {- | Run a property in @IO@ against a generated CSV text, cleaning up the temp file afterwards no matter what. -} withCsvFile :: String -> T.Text -> (FilePath -> IO a) -> IO a withCsvFile label body action = do let path = "/tmp/fastcsv_prop_" <> label <> ".csv" TIO.writeFile path body r <- action path removeFile path pure r -------------------------------------------------------------------------------- -- Properties {- | Any CSV parses the same whether or not a UTF-8 BOM (EF BB BF) is prepended. Excel / PowerShell CSV exports all come with a BOM. -} prop_bom_invariant :: ColumnNames -> [[Cell]] -> Property prop_bom_invariant (ColumnNames header) rows = monadicIO $ do let cellRows = map (map unCell) rows csv = encodeCsv ',' header cellRows csvWithBom = T.pack "\xFEFF" <> csv plain <- run $ withCsvFile "bom_plain" csv D.fastReadCsv withBom <- run $ withCsvFile "bom_with" csvWithBom D.fastReadCsv assert (plain == withBom) assert (dataframeDimensions plain == dataframeDimensions withBom) {- | A CSV with no embedded newlines inside quoted fields parses the same whether record separators are @\\n@ or @\\r\\n@. When quoted cells themselves contain @\\n@, a CRLF-encoded file contains a literal @\\r\\n@ inside the quotes (that's data, not line ending), so the invariant correctly no longer holds; we filter such inputs out. -} prop_crlf_invariant :: ColumnNames -> [[SingleLineCell]] -> Property prop_crlf_invariant (ColumnNames header) rows = monadicIO $ do let cellRows = map (map unSingleLineCell) rows lfCsv = encodeCsv ',' header cellRows crlfCsv = T.replace "\n" "\r\n" lfCsv dfLf <- run $ withCsvFile "crlf_lf" lfCsv D.fastReadCsv dfCrlf <- run $ withCsvFile "crlf_crlf" crlfCsv D.fastReadCsv assert (dfLf == dfCrlf) {- | A DataFrame produced by the RFC 4180 encoder round-trips through the fast reader: column names survive, row count survives, and every cell comes back bit-for-bit. Restricted to ASCII-letter-prefixed cells so that type inference always stays on 'Text'. -} prop_roundtrip_ascii :: Property prop_roundtrip_ascii = forAll (chooseInt (0, 12)) $ \nRows -> forAll (chooseInt (1, 4)) $ \nCols -> let header = [T.pack ('c' : show i) | i <- [0 .. nCols - 1]] in forAll (vectorOf nRows (vectorOf nCols arbitrary)) $ \(rawRows :: [[Cell]]) -> monadicIO $ do let rows = map (map unCell) rawRows csv = encodeCsv ',' header rows df <- run $ withCsvFile "roundtrip" csv D.fastReadCsv assertColumns header rows df assertColumns :: [T.Text] -> [[T.Text]] -> DataFrame -> PropertyM IO () assertColumns header rows df = do let (gotRows, gotCols) = dataframeDimensions df assert (gotRows == length rows) assert (gotCols == length header) let expected = L.transpose rows mapM_ ( \(name, expectedCol) -> case columnAsText name df of Just actual -> assert (actual == expectedCol) Nothing -> assert False ) (zip header expected) {- | A file that ends with an unmatched @"@ must raise 'CsvUnclosedQuote' under the default policy. The generator deliberately builds a valid prefix so the property is checking the error path, not a random parse failure. -} prop_unclosed_quote_throws :: Property prop_unclosed_quote_throws = forAll (listOf1 arbitrary) $ \(cells :: [Cell]) -> monadicIO $ do let plainRow = T.intercalate "," (map (encodeCell ',' . unCell) cells) csv = "v\n" <> plainRow <> ",\"dangling\n" result <- run $ do let path = "/tmp/fastcsv_prop_unclosed.csv" TIO.writeFile path csv r <- try @CsvParseError (D.fastReadCsv path) removeFile path pure r case result of Left CsvUnclosedQuote -> assert True _ -> assert False {- | Files whose length sits exactly at a SIMD chunk boundary must parse without an off-by-one. We generate inputs at the key critical sizes (64, 127, 128, 129, 192 bytes after the 'v\n' header) by padding a single column with ASCII letters. -} prop_boundary_sizes :: Property prop_boundary_sizes = forAll (elements [64, 127, 128, 129, 192]) $ \targetBytes -> let header = "v\n" bodyLen = targetBytes - T.length header -- Build a "aaaa\nbbbb\n..." body of exactly `bodyLen` bytes -- ending in a newline. rows = take bodyLen $ cycle (map T.singleton "abcdefghij") body = T.intercalate "\n" rows <> "\n" csv = header <> T.take bodyLen body in counterexample (show csv) $ monadicIO $ do df <- run $ withCsvFile "boundary" csv D.fastReadCsv let (rs, cs) = dataframeDimensions df -- Property: reader terminates and returns one column; the -- row count may vary depending on how the padding lines up, -- but the column metadata must be consistent. assert (cs == 1) assert (rs >= 0) {- | WS-E2 determinism: a chunk-parallel read returns exactly the same DataFrame as the sequential read, for any chunk count. The generated grid mixes Text cells (quotes, embedded separators and newlines) with a nullable numeric column so chunk-level type promotion is exercised too. -} prop_parallel_equals_sequential :: ColumnNames -> [[Cell]] -> Property prop_parallel_equals_sequential (ColumnNames header) rows = forAll (chooseInt (2, 7)) $ \nChunks -> forAll (vectorOf (length rows) numCell) $ \numCol -> monadicIO $ do let cellRows = zipWith (\r n -> map unCell r <> [n]) rows numCol csv = encodeCsv ',' (header <> ["num"]) cellRows bytes = TE.encodeUtf8 csv seqDf <- run (D.readSeparatedFromBytes 0x2C defaultReadOptions bytes) parDf <- run (D.readSeparatedFromBytesChunks nChunks 0x2C defaultReadOptions bytes) assert (seqDf == parDf) where numCell = frequency [ (4, T.pack . show <$> chooseInt (-1000, 1000)) , (2, T.pack . show <$> (choose (-10, 10) :: Gen Double)) , (1, pure "") ] tests :: [Property] tests = [ property prop_bom_invariant , property prop_crlf_invariant , property prop_roundtrip_ascii , property prop_unclosed_quote_throws , property prop_boundary_sizes , property prop_parallel_equals_sequential ]