{-# LANGUAGE MagicHash #-}
module Word12Spec where
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Property((==>))
import Control.Exception(evaluate)
import Data.Bits
import Data.Ix
import Data.Word12.Internal

instance Arbitrary Word12 where
  arbitrary = arbitrarySizedBoundedIntegral
  shrink    = shrinkIntegral

spec :: Spec
spec = do
  describe "narrow12Word" $ do
    prop "narrow12Word a <= 0xfff" $ \x -> narrow12Word x <= 0xfff

  describe "Eq/Ord" $ do
    it "Word12 uses Word16's (==)" $ do
      (W12# 0xfff0 == W12# 0x0ff0) `shouldBe` False
      (W12# 0x0ff0 == W12# 0x0ff0) `shouldBe` True
    it "Word12 uses Word16's compare" $ do
      (W12# 0xfff0 `compare` W12# 0x0ff0) `shouldBe` GT
      (W12# 0x0ff0 `compare` W12# 0x0ff0) `shouldBe` EQ
      (W12# 0x0ff0 `compare` W12# 0xfff0) `shouldBe` LT
  
  describe "Bounded" $ do
    it "maxBound" $ do
      let (W12# w16) = maxBound
      w16 == 0xfff
    it "minBound" $ do
      let (W12# w16) = minBound
      w16 == 0

  describe "Arbitrary" $ do
    prop "0x000 <= x <= 0xfff" $ \(W12# w16) -> w16 >= 0 && w16 <= 0xfff 
  describe "Ord" $ do
    prop "0x000 <= x <= 0xfff" $ \x -> x >= 0 && x <= (0xfff :: Word12)

  describe "Num" $ do
    prop "a + b <= 0xfff" $ 
      \(a, b) -> a + b <= (0xfff :: Word12)
    prop "a * b <= 0xfff" $ 
      \(a, b) -> a * b <= (0xfff :: Word12)
    prop "a - b <= 0xfff" $
      \(a, b) -> a - b <= (0xfff :: Word12)
    prop "negate a <= 0xfff" $ 
      \a -> negate a <= (0xfff :: Word12)
    prop "abs a == a" $
      \a -> abs a == (a :: Word12)
    prop "signum a == 1, a > 0" $ 
      \a -> a == 0 || signum a == (1 :: Word12)
    it "signum 0 == 0" $
      signum 0 `shouldBe` (0 :: Word12)
    it "fromInteger 42" $ do
      42     `shouldBe` (W12# 42)
    it "fromInteger maxBound" $ do
      0xfff  `shouldBe` (W12# 0xfff)
    it "fromInteger negative" $ do
      (-1)   `shouldBe` (W12# 0xfff)
    it "fromInteger over-flow" $ do
      0x1000 `shouldBe` (W12# 0)
      0x1001 `shouldBe` (W12# 1)

  describe "Bits" $ do
    prop "a .&. b <= 0xfff" $ 
      \(a, b) -> a .&. b <= (0xfff :: Word12)
    prop "a .&. 0 == 0" $ 
      \a -> a .&. 0 == (0 :: Word12)
    prop "a .|. b <= 0xfff" $ 
      \(a, b) -> a .|. b <= (0xfff :: Word12)
    prop "a .|. 0xfff == 0xfff" $ 
      \a -> a .|. 0xfff == (0xfff :: Word12)
    prop "a xor b <= 0xfff" $ 
      \(a, b) -> a `xor` b <= (0xfff :: Word12)
    prop "~a <= 0xfff" $
      \a -> complement a <= (0xfff :: Word12)
    prop "a .&. ~a == 0" $
      \a -> complement a .&. a == (0 :: Word12)
    prop "a .|. ~a == 0xfff" $
      \a -> complement a .|. a == (0xfff :: Word12)
    prop "i < 0 || i >= 12 ==> bit i == 0" $
      \i -> i < 0 || i >= 12 ==> bit i == (0 :: Word12)
    prop "popCount a <= 12" $
      \a -> popCount (a :: Word12) <= 12
    it "popCount x" $ do
      popCount (0xfff :: Word12) `shouldBe` 12
      popCount (0xf0f :: Word12) `shouldBe` 8
      popCount (0x0f0 :: Word12) `shouldBe` 4
      popCount (0xeee :: Word12) `shouldBe` 9
      popCount (0x000 :: Word12) `shouldBe` 0
    prop "bitSize a == 12" $
      \a -> bitSize (a :: Word12) == 12
    prop "isSigned a == False" $
      \a -> not $ isSigned (a :: Word12)
    --prop "i >=0 && i < 12 ==> testBit i (setBit a i) == True" $ do
    --    \(a, i) -> i >= 0 && i < 12 ==> testBit (setBit (a :: Word12) i) i
    --prop "i >=0 && i < 12 ==> testBit i (clearBit a i) == False" $ do
    --    \(a, i) -> i >= 0 && i < 12 ==> not (testBit (clearBit (a :: Word12) i) i)
    prop "shiftL a i <= 0xfff" $ 
      \(a, i) -> shiftL a i <= (0xfff :: Word12)
    prop "shiftR a i <= 0xfff" $ 
      \(a, i) -> shiftR a i <= (0xfff :: Word12)
    prop "shiftR a i == shiftL a (-i)" $
      \(a, i) -> shiftR a i == shiftL (a :: Word12) (-i)
    prop "shiftL a i == shiftR a (-i)" $
      \(a, i) -> shiftL a i == shiftR (a :: Word12) (-i)
    prop "shiftR a 12 == 0" $
      \a -> shiftR a 12 == (0 :: Word12)
    prop "shiftL a 12 == 0" $
      \a -> shiftL a 12 == (0 :: Word12)
    it "shift" $ do
      shiftL 0xfff 1    `shouldBe` (0xffe :: Word12)
      shiftL 0xf00 1    `shouldBe` (0xe00 :: Word12)
      shiftL 0xf01 (-1) `shouldBe` (0x780 :: Word12)
      shiftR 0x001 1    `shouldBe` (0x000 :: Word12)
      shiftR 0x801 (-1) `shouldBe` (0x002 :: Word12)
      shiftR 0xfff 1    `shouldBe` (0x7ff :: Word12)
    prop "rotateL a i <= 0xfff" $ 
      \(a, i) -> rotateL a i <= (0xfff :: Word12)
    prop "rotateR a i <= 0xfff" $ 
      \(a, i) -> rotateR a i <= (0xfff :: Word12)
    prop "rotateR a i == rotateL a (-i)" $
      \(a, i) -> rotateR a i == rotateL (a :: Word12) (-i)
    prop "rotateL a i == rotateR a (-i)" $
      \(a, i) -> rotateL a i == rotateR (a :: Word12) (-i)
    prop "rotateR (rotateL a i) i == a" $
      \(a, i) -> rotateR (rotateL a i) i == (a :: Word12)
    prop "rotateL (rotateR a i) i == a" $
      \(a, i) -> rotateL (rotateR a i) i == (a :: Word12)
    prop "rotateR a i == rotateR a (i `mod` 12)" $
      \(a, i) -> rotateR (a :: Word12) i == rotateR a (i `mod` 12)
    prop "rotateL a i == rotateL a (i `mod` 12)" $
      \(a, i) -> rotateL (a :: Word12) i == rotateL a (i `mod` 12)
    prop "rotateL (rotateL a i) j == rotateL a (i + j)" $
      \(a, i, j) -> rotateL (rotateL (a :: Word12) i) j == rotateL a (i + j)
    prop "rotateL (rotateL a i) j == rotateL (rotateL a j) i" $
      \(a, i, j) -> rotateL (rotateL (a :: Word12) i) j == rotateL (rotateL a j) i
    prop "rotateR (rotateR a i) j == rotateR a (i + j)" $
      \(a, i, j) -> rotateR (rotateR (a :: Word12) i) j == rotateR a (i + j)
    prop "rotateR (rotateR a i) j == rotateR (rotateR a j) i" $
      \(a, i, j) -> rotateR (rotateR (a :: Word12) i) j == rotateR (rotateR a j) i
    it "rotate" $ do
      rotateL 0xf00 1    `shouldBe` (0xe01 :: Word12)
      rotateL 0x888 1    `shouldBe` (0x111 :: Word12)
      rotateL 0x765 3    `shouldBe` (0xb2b :: Word12)
      rotateL 0x001 (-1) `shouldBe` (0x800 :: Word12)
      rotateR 0x777 1    `shouldBe` (0xbbb :: Word12)
      rotateR 0x001 1    `shouldBe` (0x800 :: Word12)
      rotateR 0x111 3    `shouldBe` (0x222 :: Word12)
      rotateR 0x801 (-1) `shouldBe` (0x003 :: Word12)
      rotateR 0x801 (-3) `shouldBe` (0x00c :: Word12)

  describe "Enum" $ do
    prop "a /= maxBound ==> succ a == a + 1" $
      \a -> a /= maxBound ==> succ a == (a + 1 :: Word12)
    it "succ maxBound" $
      evaluate (succ maxBound :: Word12) `shouldThrow` anyErrorCall
    prop "a /= minBound ==> pred a == a - 1" $
      \a -> a /= minBound ==> pred a == (a - 1 :: Word12)
    it "pred minBound" $
      evaluate (pred minBound :: Word12) `shouldThrow` anyErrorCall
    prop "toEnum, out of range 0 .. 0xfff" $
      \i -> i < 0 || i > 0xfff ==> evaluate (toEnum i :: Word12) `shouldThrow` anyErrorCall
      
    prop "0x000 <= fromEnum x <= 0xfff" $
      \a -> fromEnum a >= 0x000 && fromEnum (a :: Word12) <= 0xfff
    prop "length [i..] ==  0x1000" $
      \a -> length ([a..] :: [Word12]) `shouldBe` (0x1000 - fromIntegral a)

  describe "Show" $ do
    it "show 0 .. 4095" $ do
      map show ([0..] :: [Word12]) `shouldBe` map show ([0..0xfff] :: [Int])

  describe "Read" $ do
    it "read 0 .. 4095" $ do
      let ss = map show ([0..0xfff] :: [Int])
      map read ss `shouldBe` ([0..] :: [Word12])
    it "read 0x???" $ do
      read "0xfff"  `shouldBe` (0xfff :: Word12)
      read "0xffff" `shouldBe` (0xfff :: Word12)
      read "0x0"    `shouldBe` (0x0 :: Word12)
      read "0xf8"   `shouldBe` (0xf8 :: Word12)
    it "read negative" $ do
      read "-1"    `shouldBe` (0xfff :: Word12)
      read "-0"    `shouldBe` (0x000 :: Word12)
      read "-2048" `shouldBe` (0x800 :: Word12)
      read "-2047" `shouldBe` (0x801 :: Word12)

  describe "Ix" $ do
    prop "range (a, b) == [a..b]" $
      \(a, b) -> range (a, b :: Word12) == [a..b]
    prop "inRange (a, b) c ==> index (a, b) c == c - a" $
      \(a, b, c) -> inRange (a, b) c ==> index (a, b) c == fromIntegral ((c - a) :: Word12)
    prop "not (inRange (a, b) c) ==> index (a, b) c is error" $
      \(a, b, c) -> not (inRange (a, b) c) ==> evaluate (index (a, b) (c :: Word12)) `shouldThrow` anyErrorCall