Wrapper around the Haskell library cassava for processing CSV data in constant space via io-streams.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

test.hs 4.0KB

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