cassava-streams/test/test.hs

{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the Haskell package cassava-streams. It is
subject to the license terms in the LICENSE file found in the
top-level directory of this distribution and at
git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams
package, including this file, may be copied, modified, propagated, or
distributed except according to the terms contained in the LICENSE
file.

-}

--------------------------------------------------------------------------------
module Main (main) where

--------------------------------------------------------------------------------
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Csv hiding (Record, NamedRecord, record, header)
import qualified Data.Vector as V
import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.Csv as CSV
import Test.QuickCheck.Monadic (monadicIO, run, assert)
import Test.Tasty
import Test.Tasty.QuickCheck as QC

--------------------------------------------------------------------------------
-- | Fake record to encode and decode.  This works well because
-- Cassava and QuickCheck already have the necessary instances for
-- triples.
type Record = (Int, String, String)

--------------------------------------------------------------------------------
-- | But, Cassava doesn't have ToNamedRecord, FromNamedRecord
-- instances for triples so we have to work around there here.
newtype NamedRecord = NamedRecord {record :: Record}

instance ToNamedRecord NamedRecord where
  toNamedRecord (NamedRecord (a, b, c)) =
    namedRecord ["a" .= a, "b" .= b, "c" .= c]

instance FromNamedRecord NamedRecord where
  parseNamedRecord m = do
    a <- m .: "a"
    b <- m .: "b"
    c <- m .: "c"
    return $ NamedRecord (a, b, c)


--------------------------------------------------------------------------------
header :: Header
header = V.fromList ["a", "b", "c"]

--------------------------------------------------------------------------------
-- | Given a list of records generated by QuickCheck, encode those
-- records into a CSV ByteString then decode them back into records.
roundTrip :: (InputStream ByteString  -> IO (InputStream a))  -- ^ Decoder.
          -> (OutputStream ByteString -> IO (OutputStream a)) -- ^ Encoder.
          -> [a]                                              -- ^ Records.
          -> IO [a]
roundTrip is os recs = do
  -- Encode records to a ByteString.
  sourceList <- Streams.fromList recs
  (collector, encoded) <- Streams.listOutputStream
  encoder <- os collector
  Streams.connect sourceList encoder

  -- Decode from ByteString.
  decoder <- fmap BS.concat encoded >>= Streams.fromByteString >>= is
  (decodeStream, decoded) <- Streams.listOutputStream
  Streams.connect decoder decodeStream
  decoded

--------------------------------------------------------------------------------
prop_namedRoundTrip :: [Record] -> Property
prop_namedRoundTrip recsIn = not (null recsIn) ==> monadicIO $ do
    recsOut <- run $ roundTrip is os (map NamedRecord recsIn)
    assert $ recsIn == map record recsOut
  where
    is = CSV.decodeStreamByName >=> CSV.onlyValidRecords
    os = CSV.encodeStreamByName header

--------------------------------------------------------------------------------
prop_indexedRoundTrip :: [Record] -> Property
prop_indexedRoundTrip recsIn = not (null recsIn) ==> monadicIO $ do
    recsOut <- run $ roundTrip is os recsIn
    assert $ recsIn == recsOut
  where
    is = CSV.decodeStream NoHeader >=> CSV.onlyValidRecords
    os = CSV.encodeStream

--------------------------------------------------------------------------------
tests :: TestTree
tests = testGroup "Tests"
        [ QC.testProperty "namedRoundTrip"   prop_namedRoundTrip
        , QC.testProperty "indexedRoundTrip" prop_indexedRoundTrip
        ]

--------------------------------------------------------------------------------
main :: IO ()
main = defaultMain tests