Permutation.hs

module Tests.Extra.Semigroup.Permutation (tests) where

import AtCoder.Extra.Semigroup.Permutation qualified as P
import Control.Exception (evaluate)
import Data.Vector.Unboxed qualified as VU
import System.IO.Unsafe (unsafePerformIO)
import Test.Hspec
import Test.QuickCheck.Classes qualified as QCC
import Test.Tasty
import Test.Tasty.Hspec
import Test.Tasty.QuickCheck as QC
import Tests.Util (laws)

spec_invalid :: IO TestTree
spec_invalid = testSpec "boundary check" $ do
  let !_ = P.new $ VU.fromList [0]
  let !_ = P.new $ VU.fromList [-1] -- -1 is allowed
  it "throws error 1" $ do
    evaluate (P.new (VU.fromList [1])) `shouldThrow` anyException
  it "throws error 2" $ do
    evaluate (P.new (VU.fromList [-2])) `shouldThrow` anyException

prop_ident :: P.Permutation -> QC.Property
prop_ident p =
  QC.conjoin
    [ p <> ident QC.=== p,
      ident <> p QC.=== p
    ]
  where
    ident = P.ident (P.length p)

prop_zero :: P.Permutation -> QC.Property
prop_zero p =
  QC.conjoin
    [ p <> zero QC.=== zero,
      zero <> p QC.=== zero
    ]
  where
    zero = P.zero (P.length p)

prop_identAct :: QC.Positive Int -> QC.Gen QC.Property
prop_identAct (QC.Positive len) = do
  let p = P.ident len
  i <- QC.chooseInt (0, len - 1)
  pure $ P.act p i QC.=== i

prop_zeroAct :: QC.Positive Int -> QC.Gen QC.Property
prop_zeroAct (QC.Positive len) = do
  let p = P.zero len
  i <- QC.chooseInt (0, len - 1)
  pure $ P.act p i QC.=== i

-- orphan instance
instance QC.Arbitrary P.Permutation where
  arbitrary = do
    let n = 33
    vec <- VU.fromList <$> QC.vectorOf n (QC.chooseInt (-1, n - 1))
    pure $ P.new vec

tests :: [TestTree]
tests =
  [ unsafePerformIO spec_invalid,
    QC.testProperty "ident" prop_ident,
    QC.testProperty "zero" prop_zero,
    QC.testProperty "identAct" prop_identAct,
    QC.testProperty "zeroAct" prop_zeroAct,
    laws
      @P.Permutation
      [ QCC.semigroupLaws
      ]
  ]