vector-pull-0.1.0.0: tests/spec.hs

{-# LANGUAGE Strict #-}

-- |
-- Module      : vector-pull/tests/spec.hs
-- Copyright   : (c) Michael Ledger 2026
-- License     : MPL-2.0
-- Maintainer  : Michael Ledger <mike@quasimal.com>
--
-- Largely generated with the help of claude-code, hence the smelly quality
module Main where

import Data.Foldable
import Data.List qualified as List
import Data.Maybe (isNothing)
import Data.Vector (Vector)
import Data.Vector qualified as V
import Data.Vector.Pull qualified as P
import Hedgehog
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Test.Hspec
import Test.Hspec.Hedgehog

main :: IO ()
main = hspec spec

genInt :: Gen Int
genInt = Gen.int (Range.linear (-1000) 1000)

genIntList :: Gen [Int]
genIntList = Gen.list (Range.linear 0 100) genInt

genIntVector :: Gen (Vector Int)
genIntVector = V.fromList <$> genIntList

genNonEmptyIntList :: Gen [Int]
genNonEmptyIntList = Gen.list (Range.linear 1 100) genInt

genNonNegativeInt :: Gen Int
genNonNegativeInt = Gen.int (Range.linear 0 100)

spec :: Spec
spec = do
  describe "Data.Vector.Pull" do
    constructionSpec
    manipulationSpec
    indexingSpec
    updateSpec
    consumingSpec
    mappingSpec
    foldSpec
    instanceSpec

constructionSpec :: Spec
constructionSpec = describe "Construction" do
  describe "fromList" do
    it "roundtrips with toList" $ hedgehog do
      xs <- forAll genIntList
      toList (P.fromList xs) === xs

  describe "empty" do
    it "has length 0" do
      P.length (P.empty @Int) `shouldBe` 0

    it "converts to empty vector" do
      P.toVector @Vector (P.empty @Int) `shouldBe` V.empty

  describe "singleton" do
    it "creates a Pull with one element" $ hedgehog do
      x <- forAll genInt
      P.toVector @Vector (P.singleton x) === V.singleton x

    it "has length 1" $ hedgehog do
      x <- forAll genInt
      P.length (P.singleton x) === 1

  describe "append" do
    it "concatenates two Pulls" $ hedgehog do
      xs <- forAll genIntVector
      ys <- forAll genIntVector
      P.toVector @Vector (P.fromVector xs `P.append` P.fromVector ys) === (xs <> ys)

  describe "enumFromTo" do
    it "creates a range" do
      P.toVector @Vector (P.enumFromTo (1 :: Int) 5) `shouldBe` V.fromList [1, 2, 3, 4, 5]

    it "handles single element range" do
      P.toVector @Vector (P.enumFromTo (3 :: Int) 3) `shouldBe` V.singleton 3

  describe "enumFromLen" do
    it "creates a range with specific length" do
      P.toVector @Vector (P.enumFromLen (1 :: Int) 5) `shouldBe` V.fromList [1, 2, 3, 4, 5]

    it "handles zero length" do
      P.toVector @Vector (P.enumFromLen (1 :: Int) 0) `shouldBe` V.empty

  describe "replicate" do
    it "creates n copies of an element" $ hedgehog do
      n <- forAll genNonNegativeInt
      x <- forAll genInt
      P.toVector @Vector (P.replicate n x) === V.replicate n x

  describe "generate" do
    it "creates elements from a function" do
      P.toVector @Vector (P.generate 5 (* 2)) `shouldBe` V.fromList [0, 2, 4, 6, 8]

  describe "cons" do
    it "prepends an element" $ hedgehog do
      x <- forAll genInt
      xs <- forAll genIntVector
      P.toVector @Vector (P.cons x (P.fromVector xs)) === V.cons x xs

  describe "snoc" do
    it "appends an element" $ hedgehog do
      xs <- forAll genIntVector
      x <- forAll genInt
      P.toVector @Vector (P.snoc (P.fromVector xs) x) === V.snoc xs x

  describe "surround" do
    it "adds elements at both ends" $ hedgehog do
      l <- forAll genInt
      xs <- forAll genIntVector
      r <- forAll genInt
      P.toVector @Vector (P.surround l (P.fromVector xs) r) === V.cons l (V.snoc xs r)

  describe "intersperse" do
    it "intersperses an element" do
      P.toVector @Vector (P.intersperse 0 (P.fromList [1, 2, 3 :: Int])) `shouldBe` V.fromList [1, 0, 2, 0, 3]

    it "handles empty list" do
      P.toVector @Vector (P.intersperse 0 (P.empty @Int)) `shouldBe` V.empty

    it "handles singleton" do
      P.toVector @Vector (P.intersperse 0 (P.singleton (1 :: Int))) `shouldBe` V.singleton 1

manipulationSpec :: Spec
manipulationSpec = describe "Manipulation" do
  describe "take" do
    it "takes first n elements" $ hedgehog do
      n <- forAll genNonNegativeInt
      xs <- forAll genIntVector
      P.toVector @Vector (P.take n (P.fromVector xs)) === V.take n xs

    it "handles taking more than length" do
      P.toVector @Vector (P.take 10 (P.fromVector (V.fromList [1, 2, 3 :: Int]))) `shouldBe` V.fromList [1, 2, 3]

    it "handles negative take (should clamp to 0)" do
      P.toVector @Vector (P.take (-5) (P.fromVector (V.fromList [1, 2, 3 :: Int]))) `shouldBe` V.empty

  describe "drop" do
    it "drops first n elements" $ hedgehog do
      n <- forAll genNonNegativeInt
      xs <- forAll genIntVector
      (P.toVector @Vector $! P.drop n $! P.fromVector xs) === V.drop n xs

    it "handles dropping more than length" do
      (P.toVector @Vector $! P.drop 10 $! P.fromVector $! V.fromList [1, 2, 3 :: Int]) `shouldBe` V.empty

    it "handles negative drop (should be identity)" do
      (P.toVector @Vector $! P.drop (-5) $! P.fromVector $! V.fromList [1, 2, 3 :: Int]) `shouldBe` V.fromList [1, 2, 3]

    it "property: works with any Int (including negative)" $ hedgehog do
      n <- forAll genInt
      xs <- forAll genIntVector
      (P.toVector @Vector $! P.drop n $! P.fromVector xs) === V.drop n xs

indexingSpec :: Spec
indexingSpec = describe "Indexing" do
  describe "(!)" do
    it "indexes correctly" do
      let p = P.fromList [10, 20, 30 :: Int]
      p P.! 0 `shouldBe` 10
      p P.! 1 `shouldBe` 20
      p P.! 2 `shouldBe` 30

    it "throws on out of bounds" do
      let p = P.fromList [1 :: Int]
      (pure $! p P.! 5) `shouldThrow` anyErrorCall

  describe "(!?)" do
    it "returns Just for valid index" do
      let p = P.fromList [10, 20, 30 :: Int]
      (p P.!? 1) `shouldBe` Just 20

    it "returns Nothing for invalid index" do
      let p = P.fromList [1, 2, 3 :: Int]
      (p P.!? 10) `shouldBe` Nothing
      (p P.!? (-1)) `shouldBe` Nothing

updateSpec :: Spec
updateSpec = describe "Updates" do
  describe "set" do
    it "sets an element at index" do
      let p = P.fromList [1, 2, 3 :: Int]
      P.toVector @Vector (P.set p 1 99) `shouldBe` V.fromList [1, 99, 3]

  describe "modify" do
    it "modifies an element at index" do
      let p = P.fromList [1, 2, 3 :: Int]
      P.toVector @Vector (P.modify p 1 (* 10)) `shouldBe` V.fromList [1, 20, 3]

consumingSpec :: Spec
consumingSpec = describe "Consuming" do
  describe "toVector" do
    it "converts to Vector" $ hedgehog do
      xs <- forAll genIntList
      P.toVector (P.fromList xs) === V.fromList xs

  describe "toList" do
    it "converts to list" $ hedgehog do
      xs <- forAll genIntList
      toList (P.fromList xs) === xs

  describe "uncons" do
    it "returns Nothing for empty" do
      P.uncons (P.empty @Int) `shouldSatisfy` isNothing

    it "returns head and tail" do
      let Just (h, t) = P.uncons (P.fromList [1, 2, 3 :: Int])
      h `shouldBe` 1
      P.toVector @Vector t `shouldBe` V.fromList [2, 3]

  describe "head" do
    it "returns Nothing for empty" do
      P.head (P.empty @Int) `shouldBe` Nothing

    it "returns first element" $ hedgehog do
      x <- forAll genInt
      xs <- forAll genIntList
      P.head (P.fromList (x : xs)) === Just x

  describe "last" do
    it "returns Nothing for empty" do
      P.last (P.empty @Int) `shouldBe` Nothing

    it "returns last element" $ hedgehog do
      xs <- forAll genNonEmptyIntList
      P.last (P.fromList xs) === Just (List.last xs)

  describe "length" do
    it "returns correct length" $ hedgehog do
      xs <- forAll genIntVector
      P.length (P.fromVector xs) === length xs

mappingSpec :: Spec
mappingSpec = describe "Mapping" do
  describe "map" do
    it "maps a function over elements" $ hedgehog do
      xs <- forAll genIntVector
      P.toVector @Vector (fmap (* 2) (P.fromVector xs)) === fmap (* 2) xs

  describe "imap" do
    it "maps with index" do
      P.toVector @Vector (P.imap (+) (P.fromList [10, 20, 30 :: Int])) `shouldBe` V.fromList [10, 21, 32]

  describe "zipWith" do
    it "zips two Pulls" $ hedgehog do
      xs <- forAll genIntVector
      ys <- forAll genIntVector
      P.toVector @Vector (P.zipWith (+) (P.fromVector xs) (P.fromVector ys)) === V.zipWith (+) xs ys

  describe "enumerate" do
    it "pairs elements with indices" do
      let result = P.toVector @Vector (P.map (\(P.Enumerated i x) -> (i, x)) (P.enumerate (P.fromList "abc")))
      result `shouldBe` V.fromList [(0, 'a'), (1, 'b'), (2, 'c')]

foldSpec :: Spec
foldSpec = describe "Folds" do
  describe "foldr" do
    it "right folds" $ hedgehog do
      xs <- forAll genIntVector
      P.foldr (+) 0 (P.fromVector xs) === foldr (+) 0 xs

    it "preserves order" do
      P.foldr (:) [] (P.fromVector (V.fromList [1, 2, 3 :: Int])) `shouldBe` [1, 2, 3]

  describe "foldr'" do
    it "strict right folds" $ hedgehog do
      xs <- forAll genIntVector
      P.foldr' (+) 0 (P.fromVector xs) === foldr (+) 0 xs

  describe "foldl" do
    it "left folds" $ hedgehog do
      xs <- forAll genIntVector
      P.foldl (+) 0 (P.fromVector xs) === foldl (+) 0 xs

  describe "foldl'" do
    it "strict left folds" $ hedgehog do
      xs <- forAll genIntVector
      P.foldl' (+) 0 (P.fromVector xs) === foldl' (+) 0 xs

  describe "ifoldr" do
    it "right folds with index" do
      P.ifoldr (\i x acc -> (i, x) : acc) [] (P.fromList "ab")
        `shouldBe` [(0, 'a'), (1, 'b')]

  describe "ifoldl'" do
    it "strict left folds with index" do
      P.ifoldl' (\i acc x -> acc + i + x) 0 (P.fromList [10, 20, 30 :: Int])
        `shouldBe` 63 -- 0 + (0+10) + (1+20) + (2+30)

instanceSpec :: Spec
instanceSpec = describe "Instances" do
  describe "Functor" do
    it "fmap is map" $ hedgehog do
      xs <- forAll genIntVector
      P.toVector @Vector (fmap (* 2) (P.fromVector xs)) === fmap (* 2) xs

  describe "Applicative" do
    it "pure creates singleton" do
      P.toVector @Vector (pure (42 :: Int) :: P.Pull Int) `shouldBe` V.singleton 42

    it "liftA2 works" do
      let
        p1 = P.fromList [1, 2 :: Int]
        p2 = P.fromList [10, 20 :: Int]
      P.toVector @Vector (liftA2 (+) p1 p2) `shouldBe` V.fromList [11, 21, 12, 22]

  describe "Monad" do
    it "bind works" do
      let p = P.fromList [1, 2, 3 :: Int]
      P.toVector @Vector (p >>= \x -> P.fromList [x, x * 10]) `shouldBe` V.fromList [1, 10, 2, 20, 3, 30]

  describe "Foldable" do
    it "sum via Foldable" $ hedgehog do
      xs <- forAll genIntVector
      sum (P.fromVector xs) === sum xs

    it "length via Foldable" $ hedgehog do
      xs <- forAll genIntVector
      length (P.fromVector xs) === length xs

  describe "Semigroup" do
    it "(<>)" $ hedgehog do
      xs <- forAll genIntVector
      ys <- forAll genIntVector
      P.toVector @Vector (P.fromVector xs <> P.fromVector ys) === (xs <> ys)

  describe "Monoid" do
    it "mempty is empty" do
      P.toVector @Vector (mempty :: P.Pull Int) `shouldBe` V.empty

  describe "Show" do
    it "shows like a vector" do
      show (P.fromList [1, 2, 3 :: Int]) `shouldBe` "[1,2,3]"