{-# 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 NoHeader input decodesWithAs :: DecodeOptions -> BL.ByteString -> [[B.ByteString]] -> Assertion decodesWithAs opts input expected = assertResult input expected $ decodeWith opts NoHeader 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 (map V.fromList input) @?= expected encodesWithAs :: EncodeOptions -> [[B.ByteString]] -> BL.ByteString -> Assertion encodesWithAs opts input expected = encodeWith opts (map V.fromList input) @?= expected namedEncodesAs :: [B.ByteString] -> [[(B.ByteString, B.ByteString)]] -> BL.ByteString -> Assertion namedEncodesAs hdr input expected = encodeByName (V.fromList hdr) (map HM.fromList input) @?= expected namedEncodesWithAs :: EncodeOptions -> [B.ByteString] -> [[(B.ByteString, B.ByteString)]] -> BL.ByteString -> Assertion namedEncodesWithAs opts hdr input expected = encodeByNameWith opts (V.fromList hdr) (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 NoHeader 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 NoHeader 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" , testCase "newline" $ encodesWithAs (defEnc {encUseCrLf = False}) [["1", "2"], ["3", "4"]] "1,2\n3,4\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 "encodeWith" $ map encodeWithTest [ ("no header", defEnc {encIncludeHeader = False}, ["field"], [[("field", "abc")]], "abc\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")]]) , ("cr header", "field\rabc", ["field"], [[("field", "abc")]]) , ("cr trailing", "field\rabc\r", ["field"], [[("field", "abc")]]) , ("cr separator", "field\rabc\rdef", ["field"], [[("field", "abc")],[("field","def")]]) ] encodeTest (name, hdr, input, expected) = testCase name $ namedEncodesAs hdr input expected encodeWithTest (name, opts, hdr, input, expected) = testCase name $ namedEncodesWithAs opts 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 defEnc = defaultEncodeOptions ------------------------------------------------------------------------ -- 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 (V.fromList record) == decode NoHeader (encode record) where record = [(x, dummy)] dummy = 'a' roundTripUnicode :: T.Text -> Assertion roundTripUnicode x = Right (V.fromList record) @=? decode NoHeader (encode record) where record = [(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) partialDecode :: Parser a -> Assertion partialDecode p = case runParser p of Left _ -> return () Right _ -> assertFailure "expected partial field decode" expect :: (Eq a, Show a) => Parser a -> a -> Assertion expect p a0 = case runParser p of Right a -> a @=? a0 Left e -> assertFailure e 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.") ] , testGroup "Partial Decodes" [ testCase "Int" (partialDecode (parseField "12.7" :: Parser Int)) , testCase "Word" (partialDecode (parseField "12.7" :: Parser Word)) , testCase "Double" (partialDecode (parseField "1.0+" :: Parser Double)) , testCase "Integer" (partialDecode (parseField "1e6" :: Parser Integer)) ] , testGroup "Space trimming" [ testCase "_Int" (expect (parseField " 12" :: Parser Int) 12) , testCase "Int_" (expect (parseField "12 " :: Parser Int) 12) , testCase "_Int_" (expect (parseField " 12 " :: Parser Int) 12) , testCase "_Word" (expect (parseField " 12" :: Parser Word) 12) , testCase "Word_" (expect (parseField "12 " :: Parser Word) 12) , testCase "_Word_" (expect (parseField " 12 " :: Parser Word) 12) , testCase "_Double" (expect (parseField " 1.2e1" :: Parser Double) 12) , testCase "Double_" (expect (parseField "1.2e1 " :: Parser Double) 12) , testCase "_Double_" (expect (parseField " 1.2e1 " :: Parser Double) 12) ] ] ------------------------------------------------------------------------ -- Custom options tests customDelim :: Word8 -> B.ByteString -> B.ByteString -> Property customDelim delim f1 f2 = delim `notElem` [cr, nl, dquote] ==> (decodeWith decOpts NoHeader (encodeWith encOpts [V.fromList [f1, f2]]) == Right (V.fromList [V.fromList [f1, f2]])) where encOpts = defaultEncodeOptions { encDelimiter = delim } decOpts = defaultDecodeOptions { decDelimiter = delim } nl = 10 cr = 13 dquote = 34 customOptionsTests :: [TF.Test] customOptionsTests = [ testProperty "customDelim" customDelim ] ------------------------------------------------------------------------ -- Test harness allTests :: [TF.Test] allTests = [ testGroup "positional" positionalTests , testGroup "named" nameBasedTests , testGroup "conversion" conversionTests , testGroup "custom-options" customOptionsTests ] main :: IO () main = defaultMain allTests