@@ -0,0 +1,105 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+{-
4+
5+This file is part of the Haskell package cassava-streams. It is
6+subject to the license terms in the LICENSE file found in the
7+top-level directory of this distribution and at
8+git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams
9+package, including this file, may be copied, modified, propagated, or
10+distributed except according to the terms contained in the LICENSE
11+file.
12+
13+-}
14+
15+--------------------------------------------------------------------------------
16+module Main (main) where
17+
18+--------------------------------------------------------------------------------
19+import Control.Monad
20+import Data.ByteString (ByteString)
21+import qualified Data.ByteString as BS
22+import Data.Csv hiding (Record, NamedRecord, record, header)
23+import qualified Data.Vector as V
24+import System.IO.Streams (InputStream, OutputStream)
25+import qualified System.IO.Streams as Streams
26+import qualified System.IO.Streams.Csv as CSV
27+import Test.QuickCheck.Monadic (monadicIO, run, assert)
28+import Test.Tasty
29+import Test.Tasty.QuickCheck as QC
30+
31+--------------------------------------------------------------------------------
32+-- | Fake record to encode and decode. This works well because
33+-- Cassava and QuickCheck already have the necessary instances for
34+-- triples.
35+type Record = (Int, String, String)
36+
37+--------------------------------------------------------------------------------
38+-- | But, Cassava doesn't have ToNamedRecord, FromNamedRecord
39+-- instances for triples so we have to work around there here.
40+newtype NamedRecord = NamedRecord {record :: Record}
41+
42+instance ToNamedRecord NamedRecord where
43+ toNamedRecord (NamedRecord (a, b, c)) =
44+ namedRecord ["a" .= a, "b" .= b, "c" .= c]
45+
46+instance FromNamedRecord NamedRecord where
47+ parseNamedRecord m = do
48+ a <- m .: "a"
49+ b <- m .: "b"
50+ c <- m .: "c"
51+ return $ NamedRecord (a, b, c)
52+
53+
54+--------------------------------------------------------------------------------
55+header :: Header
56+header = V.fromList ["a", "b", "c"]
57+
58+--------------------------------------------------------------------------------
59+-- | Given a list of records generated by QuickCheck, encode those
60+-- records into a CSV ByteString then decode them back into records.
61+roundTrip :: (InputStream ByteString -> IO (InputStream a)) -- ^ Decoder.
62+ -> (OutputStream ByteString -> IO (OutputStream a)) -- ^ Encoder.
63+ -> [a] -- ^ Records.
64+ -> IO [a]
65+roundTrip is os recs = do
66+ -- Encode records to a ByteString.
67+ sourceList <- Streams.fromList recs
68+ (collector, encoded) <- Streams.listOutputStream
69+ encoder <- os collector
70+ Streams.connect sourceList encoder
71+
72+ -- Decode from ByteString.
73+ decoder <- (encoded >>= Streams.fromByteString . BS.concat) >>= is
74+ (decodeStream, decoded) <- Streams.listOutputStream
75+ Streams.connect decoder decodeStream
76+ decoded
77+
78+--------------------------------------------------------------------------------
79+prop_namedRoundTrip :: [Record] -> Property
80+prop_namedRoundTrip recsIn = not (null recsIn) ==> monadicIO $ do
81+ recsOut <- run $ roundTrip is os (map NamedRecord recsIn)
82+ assert $ recsIn == map record recsOut
83+ where
84+ is = CSV.decodeStreamByName >=> CSV.onlyValidRecords
85+ os = CSV.encodeStreamByName header
86+
87+--------------------------------------------------------------------------------
88+prop_indexedRoundTrip :: [Record] -> Property
89+prop_indexedRoundTrip recsIn = not (null recsIn) ==> monadicIO $ do
90+ recsOut <- run $ roundTrip is os recsIn
91+ assert $ recsIn == recsOut
92+ where
93+ is = CSV.decodeStream NoHeader >=> CSV.onlyValidRecords
94+ os = CSV.encodeStream
95+
96+--------------------------------------------------------------------------------
97+tests :: TestTree
98+tests = testGroup "Tests"
99+ [ QC.testProperty "namedRoundTrip" prop_namedRoundTrip
100+ , QC.testProperty "indexedRoundTrip" prop_indexedRoundTrip
101+ ]
102+
103+--------------------------------------------------------------------------------
104+main :: IO ()
105+main = defaultMain tests