UnitTests.hs

{-# 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