{-# LANGUAGE RankNTypes #-} module Main ( main ) where import Hedgehog (Property, property, forAll, (===), Gen) import Test.Tasty (defaultMain, TestTree, testGroup) import qualified Data.List.NeoNonEmpty as NNE import qualified Data.List.NonEmpty as NE import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Test.Tasty.Hedgehog as H main :: IO () main = defaultMain tests genNonEmpty :: Gen (NNE.NonEmpty Char) genNonEmpty = NNE.fromNonEmpty <$> Gen.nonEmpty (Range.linear 0 100) Gen.alpha againstNonEmpty :: (Show b, Eq b) => (NE.NonEmpty Char -> b) -> (NNE.NonEmpty Char -> b) -> Property againstNonEmpty f g = property $ do xs <- forAll genNonEmpty f (NNE.toNonEmpty xs) === g xs snocOne :: Property snocOne = property $ do x <- forAll Gen.alpha NNE.unsnoc (NNE.singleton x) === ([], x) snocUnsnoc :: Property snocUnsnoc = property $ do x <- forAll Gen.alpha xs <- forAll genNonEmpty NNE.unsnoc (NNE.snoc xs x) === (NNE.toList xs, x) tests :: TestTree tests = testGroup "hedgehog properties" [ H.testProperty "length" $ againstNonEmpty NE.length NNE.length , H.testProperty "roundtrips singleton forwards" $ property $ do x <- forAll $ Gen.int $ Range.linear (-25) 25 x NE.:| [] === NNE.toNonEmpty (NNE.singleton x) , H.testProperty "roundtrips singleton backwards" $ property $ do x <- forAll $ Gen.int $ Range.linear (-25) 25 NNE.fromNonEmpty (x NE.:| []) === NNE.singleton x , H.testProperty "NE.:| === NNE.fromCons forwards" $ property $ do x <- forAll Gen.alpha xs <- forAll $ Gen.list (Range.linear 0 100) Gen.alpha (x NE.:| xs) === NNE.toNonEmpty (NNE.fromCons x xs) , H.testProperty "aNonEmpty === id" $ property $ do xs <- forAll $ Gen.nonEmpty (Range.linear 0 100) Gen.alpha let xs' = NNE.fromNonEmpty xs NNE.aNonEmpty xs' === xs' , H.testProperty "head" $ againstNonEmpty NE.head NNE.head , H.testProperty "tail" $ againstNonEmpty NE.tail NNE.tail , H.testProperty "last" $ againstNonEmpty NE.last NNE.last , H.testProperty "init" $ againstNonEmpty NE.init NNE.init , H.testProperty "cons" $ property $ do x <- forAll Gen.alpha xs <- forAll genNonEmpty NNE.toList (NNE.cons x xs) === NE.toList (x NE.:| NNE.toList xs) NNE.toList (x NNE.:| NNE.toList xs) === NE.toList (x NE.:| NNE.toList xs) let x' NNE.:| xs' = xs let y' : ys = NNE.toList xs x' === y' xs' === ys , H.testProperty "uncons" $ property $ do x <- forAll Gen.alpha xs <- forAll $ Gen.nonEmpty (Range.linear 0 100) Gen.alpha NNE.toList (NNE.cons x $ NNE.fromNonEmpty xs) === NE.toList (x NE.:| NE.toList xs) , H.testProperty "snocOne" snocOne , H.testProperty "snoc/unsnoc" snocUnsnoc , H.testProperty "(!?)" $ property $ do ind <- forAll $ Gen.int $ Range.linear 0 10 xs <- forAll genNonEmpty case xs NNE.!? ind of Just a -> a === (NNE.toList xs !! ind) Nothing -> pure () ]