Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

277 lines (245 sloc) 11.369 kb
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main
( main
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.HashMap.Strict as HM
import Data.Int
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Vector as V
import Data.Word
import Test.HUnit
import Test.Framework as TF
import Test.Framework.Providers.HUnit as TF
import Test.QuickCheck
import Test.Framework.Providers.QuickCheck2 as TF
import Data.Csv hiding (record)
import qualified Data.Csv.Streaming as S
------------------------------------------------------------------------
-- Parse tests
decodesAs :: BL.ByteString -> [[B.ByteString]] -> Assertion
decodesAs input expected = assertResult input expected $ decode False input
decodesWithAs :: DecodeOptions -> BL.ByteString -> [[B.ByteString]] -> Assertion
decodesWithAs opts input expected =
assertResult input expected $ decodeWith opts False input
assertResult :: BL.ByteString -> [[B.ByteString]]
-> Either String (V.Vector (V.Vector B.ByteString)) -> Assertion
assertResult input expected res = case res of
Right r -> V.fromList (map V.fromList expected) @=? r
Left err -> assertFailure $
" input: " ++ show (BL8.unpack input) ++ "\n" ++
"parse error: " ++ err
encodesAs :: [[B.ByteString]] -> BL.ByteString -> Assertion
encodesAs input expected =
encode (V.fromList (map V.fromList input)) @?= expected
encodesWithAs :: EncodeOptions -> [[B.ByteString]] -> BL.ByteString -> Assertion
encodesWithAs opts input expected =
encodeWith opts (V.fromList (map V.fromList input)) @?= expected
namedEncodesAs :: [B.ByteString] -> [[(B.ByteString, B.ByteString)]]
-> BL.ByteString -> Assertion
namedEncodesAs hdr input expected =
encodeByName (V.fromList hdr)
(V.fromList $ map HM.fromList input) @?= expected
namedDecodesAs :: BL.ByteString -> [B.ByteString]
-> [[(B.ByteString, B.ByteString)]] -> Assertion
namedDecodesAs input ehdr expected = case decodeByName input of
Right r -> (V.fromList ehdr, expected') @=? r
Left err -> assertFailure $
" input: " ++ show (BL8.unpack input) ++ "\n" ++
"parse error: " ++ err
where
expected' = V.fromList $ map HM.fromList expected
recordsToList :: S.Records a -> Either String [a]
recordsToList (S.Nil (Just err) _) = Left err
recordsToList (S.Nil Nothing _) = Right []
recordsToList (S.Cons (Left err) _) = Left err
recordsToList (S.Cons (Right x) rs) = case recordsToList rs of
l@(Left _) -> l
(Right xs) -> Right (x : xs)
decodesStreamingAs :: BL.ByteString -> [[B.ByteString]] -> Assertion
decodesStreamingAs input expected =
assertResult input expected $ fmap (V.fromList . map V.fromList) $
recordsToList $ S.decode False input
decodesWithStreamingAs :: DecodeOptions -> BL.ByteString -> [[B.ByteString]]
-> Assertion
decodesWithStreamingAs opts input expected =
assertResult input expected $ fmap (V.fromList . map V.fromList) $
recordsToList $ S.decodeWith opts False input
namedDecodesStreamingAs :: BL.ByteString -> [B.ByteString]
-> [[(B.ByteString, B.ByteString)]] -> Assertion
namedDecodesStreamingAs input ehdr expected = case S.decodeByName input of
Right (hdr, rs) -> case recordsToList rs of
Right xs -> (V.fromList ehdr, expected') @=? (hdr, xs)
Left err -> assertFailure $
" input: " ++ show (BL8.unpack input) ++ "\n" ++
"conversion error: " ++ err
Left err -> assertFailure $
" input: " ++ show (BL8.unpack input) ++ "\n" ++
"parse error: " ++ err
where
expected' = map HM.fromList expected
positionalTests :: [TF.Test]
positionalTests =
[ testGroup "encode" $ map encodeTest
[ ("simple", [["abc"]], "abc\r\n")
, ("quoted", [["\"abc\""]], "\"\"\"abc\"\"\"\r\n")
, ("quote", [["a\"b"]], "\"a\"\"b\"\r\n")
, ("quotedQuote", [["\"a\"b\""]], "\"\"\"a\"\"b\"\"\"\r\n")
, ("leadingSpace", [[" abc"]], "\" abc\"\r\n")
, ("comma", [["abc,def"]], "\"abc,def\"\r\n")
, ("twoFields", [["abc","def"]], "abc,def\r\n")
, ("twoRecords", [["abc"], ["def"]], "abc\r\ndef\r\n")
, ("newline", [["abc\ndef"]], "\"abc\ndef\"\r\n")
]
, testGroup "encodeWith"
[ testCase "tab-delim" $ encodesWithAs (defEnc { encDelimiter = 9 })
[["1", "2"]] "1\t2\r\n"
]
, testGroup "decode" $ map decodeTest decodeTests
, testGroup "decodeWith" $ map decodeWithTest decodeWithTests
, testGroup "streaming"
[ testGroup "decode" $ map streamingDecodeTest decodeTests
, testGroup "decodeWith" $ map streamingDecodeWithTest decodeWithTests
]
]
where
rfc4180Input = BL8.pack $
"#field1,field2,field3\n" ++
"\"aaa\",\"bb\n" ++
"b\",\"ccc\"\n" ++
"\"a,a\",\"b\"\"bb\",\"ccc\"\n" ++
"zzz,yyy,xxx\n"
rfc4180Output = [["#field1", "field2", "field3"],
["aaa", "bb\nb", "ccc"],
["a,a", "b\"bb", "ccc"],
["zzz", "yyy", "xxx"]]
decodeTests =
[ ("simple", "a,b,c\n", [["a", "b", "c"]])
, ("crlf", "a,b\r\nc,d\r\n", [["a", "b"], ["c", "d"]])
, ("noEol", "a,b,c", [["a", "b", "c"]])
, ("blankLine", "a,b,c\n\nd,e,f\n\n",
[["a", "b", "c"], ["d", "e", "f"]])
, ("leadingSpace", " a, b, c\n", [[" a", " b", " c"]])
, ("rfc4180", rfc4180Input, rfc4180Output)
]
decodeWithTests =
[ ("tab-delim", defDec { decDelimiter = 9 }, "1\t2", [["1", "2"]])
]
encodeTest (name, input, expected) =
testCase name $ input `encodesAs` expected
decodeTest (name, input, expected) =
testCase name $ input `decodesAs` expected
decodeWithTest (name, opts, input, expected) =
testCase name $ decodesWithAs opts input expected
streamingDecodeTest (name, input, expected) =
testCase name $ input `decodesStreamingAs` expected
streamingDecodeWithTest (name, opts, input, expected) =
testCase name $ decodesWithStreamingAs opts input expected
defEnc = defaultEncodeOptions
defDec = defaultDecodeOptions
nameBasedTests :: [TF.Test]
nameBasedTests =
[ testGroup "encode" $ map encodeTest
[ ("simple", ["field"], [[("field", "abc")]], "field\r\nabc\r\n")
, ("twoFields", ["field1", "field2"],
[[("field1", "abc"), ("field2", "def")]],
"field1,field2\r\nabc,def\r\n")
, ("twoRecords", ["field"], [[("field", "abc")], [("field", "def")]],
"field\r\nabc\r\ndef\r\n")
]
, testGroup "decode" $ map decodeTest decodeTests
, testGroup "streaming"
[ testGroup "decode" $ map streamingDecodeTest decodeTests
]
]
where
decodeTests =
[ ("simple", "field\r\nabc\r\n", ["field"], [[("field", "abc")]])
, ("twoFields", "field1,field2\r\nabc,def\r\n", ["field1", "field2"],
[[("field1", "abc"), ("field2", "def")]])
, ("twoRecords", "field\r\nabc\r\ndef\r\n", ["field"],
[[("field", "abc")], [("field", "def")]])
]
encodeTest (name, hdr, input, expected) =
testCase name $ namedEncodesAs hdr input expected
decodeTest (name, input, hdr, expected) =
testCase name $ namedDecodesAs input hdr expected
streamingDecodeTest (name, input, hdr, expected) =
testCase name $ namedDecodesStreamingAs input hdr expected
------------------------------------------------------------------------
-- Conversion tests
instance Arbitrary B.ByteString where
arbitrary = B.pack `fmap` arbitrary
instance Arbitrary BL.ByteString where
arbitrary = BL.fromChunks `fmap` arbitrary
instance Arbitrary T.Text where
arbitrary = T.pack `fmap` arbitrary
instance Arbitrary LT.Text where
arbitrary = LT.fromChunks `fmap` arbitrary
-- A single column with an empty string is indistinguishable from an
-- empty line (which we will ignore.) We therefore encode at least two
-- columns.
roundTrip :: (Eq a, FromField a, ToField a) => a -> Bool
roundTrip x = Right record == decode False (encode record)
where record = V.singleton (x, dummy)
dummy = 'a'
roundTripUnicode :: T.Text -> Assertion
roundTripUnicode x = Right record @=? decode False (encode record)
where record = V.singleton (x, dummy)
dummy = 'a'
boundary :: forall a. (Bounded a, Eq a, FromField a, ToField a) => a -> Bool
boundary _dummy = roundTrip (minBound :: a) && roundTrip (maxBound :: a)
conversionTests :: [TF.Test]
conversionTests =
[ testGroup "roundTrip"
[ testProperty "Char" (roundTrip :: Char -> Bool)
, testProperty "ByteString" (roundTrip :: B.ByteString -> Bool)
, testProperty "Int" (roundTrip :: Int -> Bool)
, testProperty "Integer" (roundTrip :: Integer -> Bool)
, testProperty "Int8" (roundTrip :: Int8 -> Bool)
, testProperty "Int16" (roundTrip :: Int16 -> Bool)
, testProperty "Int32" (roundTrip :: Int32 -> Bool)
, testProperty "Int64" (roundTrip :: Int64 -> Bool)
, testProperty "Word" (roundTrip :: Word -> Bool)
, testProperty "Word8" (roundTrip :: Word8 -> Bool)
, testProperty "Word16" (roundTrip :: Word16 -> Bool)
, testProperty "Word32" (roundTrip :: Word32 -> Bool)
, testProperty "Word64" (roundTrip :: Word64 -> Bool)
, testProperty "lazy ByteString"
(roundTrip :: BL.ByteString -> Bool)
, testProperty "Text" (roundTrip :: T.Text -> Bool)
, testProperty "lazy Text" (roundTrip :: LT.Text -> Bool)
]
, testGroup "boundary"
[ testProperty "Int" (boundary (undefined :: Int))
, testProperty "Int8" (boundary (undefined :: Int8))
, testProperty "Int16" (boundary (undefined :: Int16))
, testProperty "Int32" (boundary (undefined :: Int32))
, testProperty "Int64" (boundary (undefined :: Int64))
, testProperty "Word" (boundary (undefined :: Word))
, testProperty "Word8" (boundary (undefined :: Word8))
, testProperty "Word16" (boundary (undefined :: Word16))
, testProperty "Word32" (boundary (undefined :: Word32))
, testProperty "Word64" (boundary (undefined :: Word64))
]
, testGroup "Unicode"
[ testCase "Chinese" (roundTripUnicode "我能吞下玻璃而不伤身体。")
, testCase "Icelandic" (roundTripUnicode
"Sævör grét áðan því úlpan var ónýt.")
, testCase "Turkish" (roundTripUnicode
"Cam yiyebilirim, bana zararı dokunmaz.")
]
]
------------------------------------------------------------------------
-- Test harness
allTests :: [TF.Test]
allTests = [ testGroup "positional" positionalTests
, testGroup "named" nameBasedTests
, testGroup "conversion" conversionTests
]
main :: IO ()
main = defaultMain allTests
Jump to Line
Something went wrong with that request. Please try again.