Property.hs

module Test.Relude.Property
       ( hedgehogTestList
       ) where

import Relude

import Data.List (nub)
import Hedgehog (Group (..), Property, assert, forAll, property, (===))

import Test.Relude.Container.One (oneProps)
import Test.Relude.Gen (genBoolList, genIntList, genUtf8ByteString, genUtf8String, genUtf8Text)


hedgehogTestList :: [Group]
hedgehogTestList =
    [ utfProps
    , listProps
    , logicProps
    , oneProps
    ]

----------------------------------------------------------------------------
-- utf8 conversion
----------------------------------------------------------------------------

utfProps :: Group
utfProps = Group "utf8 conversion property tests"
    [ ("String to ByteString invertible:", prop_StringToBytes)
    , ("Text to ByteString invertible:", prop_TextToBytes)
    , ("ByteString to Text or String invertible:" , prop_BytesTo)
    ]

-- "\65534" fails, but this is from BU.toString
-- > import qualified Data.ByteString.UTF8 as BU
-- > BU.toString (BU.fromString "\65534") == "\65533"
-- > True
prop_StringToBytes :: Property
prop_StringToBytes = property $ do
    str <- forAll genUtf8String
    assert $ str == decodeUtf8 @_ @ByteString  (encodeUtf8 str)
          && str == decodeUtf8 @_ @LByteString (encodeUtf8 str)


prop_TextToBytes :: Property
prop_TextToBytes = property $ do
    txt <- forAll genUtf8Text
    assert $ txt == decodeUtf8 @_ @ByteString  (encodeUtf8 txt)
          && txt == decodeUtf8 @_ @LByteString (encodeUtf8 txt)

-- "\239\191\190" fails, but this is the same as "\65534" :: String
prop_BytesTo :: Property
prop_BytesTo = property $ do
    utf <- forAll genUtf8ByteString
    assert $ utf == encodeUtf8 @String (decodeUtf8 utf)
          && utf == encodeUtf8 @Text   (decodeUtf8 utf)
          && utf == encodeUtf8 @LText  (decodeUtf8 utf)

----------------------------------------------------------------------------
-- ordNub
----------------------------------------------------------------------------

listProps :: Group
listProps = Group "list function property tests"
    [ ("ordNub xs == nub xs:", prop_ordNubCorrect)
    , ("hashNub xs == nub xs:", prop_hashNubCorrect)
    , ("sortNub xs == sort (nub xs):" , prop_sortNubCorrect)
    , ("sort (unstableNub xs) == sort (nub xs):" , prop_unstableNubCorrect)
    ]

prop_ordNubCorrect :: Property
prop_ordNubCorrect = property $ do
    xs <- forAll genIntList
    ordNub xs === nub xs

prop_hashNubCorrect :: Property
prop_hashNubCorrect = property $ do
    xs <- forAll genIntList
    hashNub xs === ordNub xs

prop_sortNubCorrect :: Property
prop_sortNubCorrect = property $ do
    xs <- forAll genIntList
    sortNub xs === sort (ordNub xs)

prop_unstableNubCorrect :: Property
prop_unstableNubCorrect = property $ do
    xs <- forAll genIntList
    sort (unstableNub xs) === sortNub xs

----------------------------------------------------------------------------
-- logicM
----------------------------------------------------------------------------

logicProps :: Group
logicProps = Group "lifted logic function property tests"
    [ ("andM:", prop_andM)
    , ("orM:", prop_orM)
    ]

prop_andM :: Property
prop_andM = property $ do
    bs <- forAll genBoolList
    andM (pure <$> bs) === pure @Maybe (and bs)

prop_orM :: Property
prop_orM = property $ do
    bs <- forAll genBoolList
    orM (pure <$> bs) === pure @Maybe (or bs)