43 lines
1.2 KiB
Haskell
43 lines
1.2 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Utils.CsvSpec where
|
|
|
|
import TestImport
|
|
|
|
import Utils.Csv
|
|
|
|
import Data.Csv (toField, runParser, parseField)
|
|
|
|
import Data.Char (ord)
|
|
import qualified Data.ByteString as BS
|
|
|
|
|
|
deriving newtype instance Arbitrary a => Arbitrary (CsvSemicolonList a)
|
|
|
|
|
|
spec :: Spec
|
|
spec = modifyMaxSuccess (* 10) . parallel $ do
|
|
lawsCheckHspec (Proxy @(CsvSemicolonList ByteString))
|
|
[ csvFieldLaws ]
|
|
describe "CsvSemicolonList" $ do
|
|
let
|
|
test :: [ByteString] -> ByteString -> Expectation
|
|
test (CsvSemicolonList -> x) t = do
|
|
toField x `shouldBe` t
|
|
runParser (parseField t) `shouldBe` Right x
|
|
it "is transparent" . property $ \(bs :: ByteString)
|
|
-> let expectTransparent = BS.all (`notElem` [34, 10, 13, fromIntegral $ ord ';']) bs
|
|
&& not (BS.null bs)
|
|
in expectTransparent ==> test [bs] bs
|
|
it "behaves as expected on some examples" $ do
|
|
test ["foo"] "foo"
|
|
test ["foo", "bar"] "foo;bar"
|
|
test [] ""
|
|
test [""] "\"\""
|
|
test ["", ""] ";"
|
|
test ["foo", ""] "foo;"
|
|
test ["", "foo"] ";foo"
|
|
test ["", "", "foo", ""] ";;foo;"
|