DecodeTest.hs

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Sv.DecodeTest (test_Decode) where

import Control.Applicative (liftA2)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Char8 as BS8
import Data.Functor.Alt ((<!>))
import Data.List.NonEmpty (NonEmpty ((:|)))
import Text.Read (readMaybe)
import Data.Semigroup (Semigroup)
import Data.Semigroupoid (Semigroupoid (o))
import qualified Data.Vector as V
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))
import Data.Text

import Data.Sv
import qualified Data.Sv.Decode as D

test_Decode :: TestTree
test_Decode =
  testGroup "Decode" [
    intOrStringTest
  , varyingLengthTest
  , semigroupoidTest
  , namedTest
  ]

data IntOrString =
  I Int | S String
  deriving (Eq, Ord, Show)

intOrString :: D.Decode' ByteString IntOrString
intOrString = I <$> D.int <!> S <$> D.string

data V3 a =
  V3 a a a
  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

v3 :: Semigroup e => D.Decode e s a -> D.Decode e s (V3 a)
v3 f = sequenceA (V3 f f f)

v3ios :: D.Decode ByteString ByteString (V3 IntOrString)
v3ios = v3 intOrString

csv1 :: LBS.ByteString
csv1 = LBS.intercalate "\n" [
    "\"3\",\"4\",\"5\""
  , "\"quoted text\",unquoted text,100"
  , "7,unquoted text,5"
  ]

csv1' :: [V3 IntOrString]
csv1' =
  [ I <$> V3 3 4 5
  , V3 (S "quoted text") (S "unquoted text") (I 100)
  , V3 (I 7) (S "unquoted text") (I 5)
  ]

opts :: ParseOptions
opts = ParseOptions comma Unheaded

intOrStringTest :: TestTree
intOrStringTest =
    testCase "parse successfully" $
      parseDecode v3ios opts csv1 @?= pure csv1'

varyingLength :: LBS.ByteString
varyingLength = LBS.intercalate "\r\n" [
    "one"
  , "one,two"
  , "one,two,three"
  , "one,two,three,four"
  , "one,two,three,four,five"
  ]

str2 :: D.Decode' ByteString (ByteString, ByteString)
str2 = liftA2 (,) D.contents D.contents

varyingLengthTest :: TestTree
varyingLengthTest =
  testCase "varyingLength has all the right errors" $
    parseDecode str2 opts varyingLength @?=
      Failure (DecodeErrors (UnexpectedEndOfRow :| [
        ExpectedEndOfRow (V.fromList ["three"])
      , ExpectedEndOfRow (V.fromList ["three", "four"])
      , ExpectedEndOfRow (V.fromList ["three", "four", "five"])
      ]))

semiTestString1 :: LBS.ByteString
semiTestString1 = "hello,5,6.6,goodbye"

semiTestString2 :: LBS.ByteString
semiTestString2 = "hello,no,6.6,goodbye"

semiTestString3 :: LBS.ByteString
semiTestString3 = "hello,5,false,goodbye"

parseDecoder :: D.Decode' ByteString Int
parseDecoder = D.contents D.>>==
  \bs -> validateMaybe (D.BadDecode bs) . readMaybe . BS8.unpack $ bs

data Semi = Semi Text Int Double Text deriving (Eq, Show)

semiD :: D.Decode' ByteString Semi
semiD = Semi <$> D.utf8 <*> (parseDecoder `o` D.contents) <*> D.rational <*> D.utf8

semigroupoidTest :: TestTree
semigroupoidTest = testGroup "Semigroupoid Decode"
  [ testCase "Does the right thing in the case of success" $
      parseDecode semiD opts semiTestString1 @?=
        pure [Semi "hello" 5 6.6 "goodbye"]
  , testCase "Does the right thing in the case of left failure" $
      parseDecode semiD opts semiTestString2 @?=
        Failure (DecodeErrors (pure (BadDecode "no")))
  , testCase "Does the right thing in the case of right failure" $
      parseDecode semiD opts semiTestString3 @?=
        Failure (DecodeErrors (pure (BadDecode "Couldn't decode \"false\": input does not start with a digit")))
  ]

-- This CSV has enough columns to make an Item, it has more columns than a
-- SemiItem/SemiItem2, and not enough columns for a SuperItem/SuperItem2
namedCsv :: LBS.ByteString
namedCsv =
  LBS.intercalate "\n" [
    "id,name,cost,units"
  , "1,fridge,600,5"
  , "2,stereo,1499.99,2"
  , "3,dryer,748.95,3"
  ]

data Item = Item Int Text Double Int deriving (Eq, Show)
data SemiItem = SemiItem Text Double deriving (Eq, Show)
data SemiItem2 = SemiItem2 Int Double deriving (Eq, Show)
data SuperItem = SuperItem Int Text Text Double Int deriving (Eq, Show)
data SuperItem2 = SuperItem2 Int Text Text Double Int Double deriving (Eq, Show)

inOrder :: NameDecode' ByteString Item
inOrder =
  Item <$> D.column "id" D.int <*> D.column "name" D.utf8
    <*> D.column "cost" D.rational <*> D.column "units" D.int

outOrder :: NameDecode' ByteString Item
outOrder =
  (\n u c i -> Item i n c u) <$> D.column "name" D.utf8
    <*> D.column "units" D.int <*> D.column "cost" D.rational
    <*> D.column "id" D.int

inOrderSemi :: NameDecode' ByteString SemiItem
inOrderSemi =
  SemiItem <$> D.column "name" D.utf8 <*> D.column "cost" D.rational

outOrderSemi :: NameDecode' ByteString SemiItem2
outOrderSemi =
  SemiItem2 <$> D.column "units" D.int <*> D.column "cost" D.rational

super :: NameDecode' ByteString SuperItem
super =
  SuperItem <$> D.column "id" D.int <*> D.column "name" D.utf8
    <*> D.column "manufacturer" D.utf8
    <*> D.column "cost" D.rational <*> D.column "units" D.int

super2 :: NameDecode' ByteString SuperItem2
super2 =
  SuperItem2 <$> D.column "id" D.int <*> D.column "name" D.utf8
    <*> D.column "manufacturer" D.utf8
    <*> D.column "cost" D.rational <*> D.column "units" D.int
    <*> D.column "profit" D.rational

namedTest :: TestTree
namedTest = testGroup "Named decodes"
  [ testCase "columns in order" $
      parseDecodeNamed inOrder defaultParseOptions namedCsv @?=
        pure [Item 1 "fridge" 600 5, Item 2 "stereo" 1499.99 2, Item 3 "dryer" 748.95 3]
  , testCase "columns out of order" $
      parseDecodeNamed outOrder defaultParseOptions namedCsv @?=
        pure [Item 1 "fridge" 600 5, Item 2 "stereo" 1499.99 2, Item 3 "dryer" 748.95 3]
  , testCase "columns in order, with some skipped" $
      parseDecodeNamed inOrderSemi defaultParseOptions namedCsv @?=
        pure [SemiItem "fridge" 600, SemiItem "stereo" 1499.99, SemiItem "dryer" 748.95]
  , testCase "columns out of order, with some skipped" $
      parseDecodeNamed outOrderSemi defaultParseOptions namedCsv @?=
        pure [SemiItem2 5 600, SemiItem2 2 1499.99, SemiItem2 3 748.95]
  , testCase "one missing column" $
      parseDecodeNamed super defaultParseOptions namedCsv @?=
        Failure (DecodeErrors (MissingColumn "manufacturer":|[]))
  , testCase "multiple missing columns" $
      parseDecodeNamed super2 defaultParseOptions namedCsv @?=
        Failure (DecodeErrors (MissingColumn "manufacturer":|[MissingColumn "profit"]))
  , testCase "empty document (missing header)" $
      parseDecodeNamed inOrder defaultParseOptions "" @?=
        Failure (DecodeErrors (MissingHeader:|[]))
  , testCase "misconfigured" $
      parseDecodeNamed inOrder opts namedCsv @?=
        Failure (DecodeErrors (
          BadConfig "Your ParseOptions indicates a CSV with no header (Unheaded),\nbut your decoder requires column names."
          :|[]
        ))
  ]