module Main (main) where
import Integer
import Essentials
import Test.Hspec (hspec, describe, it, shouldBe)
import Test.Hspec.Hedgehog
((===), evalMaybe, modifyMaxSuccess, hedgehog)
import Control.DeepSeq (NFData, ($!!))
import Control.Exception (Exception, throw)
import Data.Either (Either (..))
import Data.Int (Int)
import Data.List (take)
import Data.Word (Word)
import Integer.Gen (GenFinite)
import Integer.Gen (GenIntegral)
import Prelude (Num, fromInteger, toInteger, ($!), (*), (+), (-))
import System.IO (IO)
import qualified Control.Exception as Exception (ArithException (Underflow))
import qualified Control.Monad.Catch as Exception (MonadCatch, try)
import qualified Data.Bool as Bool
import qualified Data.Either as Either
import qualified Data.Ord as Ord
import qualified Hedgehog
import qualified Integer.Gen as Gen
import qualified Prelude as Bounded (Bounded (..))
import qualified Prelude as Num (fromInteger)
import qualified Prelude as Num (toInteger)
main :: IO ()
main = hspec do
describe "Closed Num operations op behaves the same in A \
\as in Integer" $ modifyMaxSuccess (\_ -> 1000) do
let check :: forall a m. GenIntegral a => Monad m =>
(forall b. Num b => b -> b -> b) -> Hedgehog.PropertyT m ()
check o = do
x :: a <- Hedgehog.forAll Gen.integral
y :: a <- Hedgehog.forAll Gen.integral
x `o` y === fromInteger (toInteger x `o` toInteger y)
it "op = (+), A = Positive" $ hedgehog $ check @Positive (+)
it "op = (+), A = Signed" $ hedgehog $ check @Signed (+)
it "op = (*), A = Positive" $ hedgehog $ check @Positive (*)
it "op = (*), A = Signed" $ hedgehog $ check @Signed (*)
describe "subtract in A behaves the same as \
\(-) in B" $ modifyMaxSuccess (\_ -> 1000) do
let check :: forall a b m.
(GenIntegral a, Subtraction a, Subtraction' b, Num b) =>
(IntegerConvert a b, IntegerNarrow b a) =>
(Eq b, Show b) =>
Exception.MonadCatch m => Hedgehog.PropertyT m ()
check = do
x :: a <- Hedgehog.forAll Gen.integral
y :: a <- Hedgehog.forAll Gen.integral
(subtract x y :: b) === (convert x - convert y :: b)
it "A = Natural, B = Signed" $ hedgehog $ check @Natural @Signed
it "A = Natural, B = Integer" $ hedgehog $ check @Natural @Integer
it "A = Positive, B = Signed" $ hedgehog $ check @Positive @Signed
it "A = Positive, B = Integer" $ hedgehog $ check @Positive @Integer
describe "(-) in A behaves the same as (-) in Integer if the result \
\is in A, undefined otherwise" $ modifyMaxSuccess (\_ -> 1000) do
let check :: forall a m.
(GenIntegral a, Subtraction a, IntegerNarrow Integer a) =>
Exception.MonadCatch m => Hedgehog.PropertyT m ()
check = do
x :: a <- Hedgehog.forAll Gen.integral
y :: a <- Hedgehog.forAll Gen.integral
case narrow (toInteger x - toInteger y) :: Maybe a of
Just z -> x - y === z
Nothing -> do
z <- Exception.try (pure $! x - y)
z === Either.Left Exception.Underflow
it "A = Positive" $ hedgehog $ check @Positive
describe "convert (convert x) = x" do
let check :: forall a b m. (GenIntegral a, IntegerEquiv a b) =>
Monad m => Hedgehog.PropertyT m ()
check = do
x :: a <- Hedgehog.forAll Gen.integral
convert (convert x :: b) === x
it "A = Integer, B = Signed" $ hedgehog $ check @Integer @Signed
it "A = Signed, B = Integer" $ hedgehog $ check @Signed @Integer
describe "narrow (convert x) = Just x" $ modifyMaxSuccess (\_ -> 1000) do
let check :: forall a b m.
(GenIntegral a, IntegerConvert a b, IntegerNarrow b a) =>
Monad m => Hedgehog.PropertyT m ()
check = do
x :: a <- Hedgehog.forAll Gen.integral
narrow (convert x :: b) === Just x
it "A = Natural, B = Integer" $ hedgehog $ check @Natural @Integer
it "A = Natural, B = Signed" $ hedgehog $ check @Natural @Signed
it "A = Positive, B = Integer" $ hedgehog $ check @Positive @Integer
it "A = Positive, B = Signed" $ hedgehog $ check @Positive @Signed
it "A = Positive, B = Natural" $ hedgehog $ check @Positive @Natural
describe "narrow x = (Just y | convert y = x) \
\or Nothing" $ modifyMaxSuccess (\_ -> 1000) do
let check :: forall a b m. (GenIntegral a, BoundedBelow b) =>
(IntegerConvert b a, IntegerNarrow a b) =>
(Show b, Eq b) => Monad m => Hedgehog.PropertyT m ()
check = do
x :: a <- Hedgehog.forAll Gen.integral
let y :: Maybe b = narrow x
if x Ord.>= convert (minBound @b)
then do
z <- evalMaybe y
convert z === x
else y === Nothing
it "A = Integer, B = Natural" $ hedgehog $ check @Integer @Natural
it "A = Signed, B = Natural" $ hedgehog $ check @Signed @Natural
it "A = Integer, B = Positive" $ hedgehog $ check @Integer @Positive
it "A = Signed, B = Positive" $ hedgehog $ check @Signed @Positive
it "A = Natural, B = Positive" $ hedgehog $ check @Natural @Positive
describe "yolo (yolo x) = x, if Integer x is in range of A" do
let check :: forall a m. (GenIntegral a, BoundedBelow a) =>
Exception.MonadCatch m => Hedgehog.PropertyT m ()
check = do
x :: Integer <- Hedgehog.forAll Gen.integral
let y :: a = yolo x
if x Ord.>= Num.toInteger (minBound @a)
then yolo y === x
else do
z <- Exception.try (pure $! y)
z === Either.Left Exception.Underflow
it "A = Positive" $ hedgehog $ check @Positive
it "A = Natural " $ hedgehog $ check @Natural
describe "toFinite x = (Just y | fromInteger y = x) \
\or Nothing" $ modifyMaxSuccess (\_ -> 1000) do
let check :: forall a b m. Monad m =>
(ConvertWithFinite a, GenIntegral a, Show a) =>
(Integer.Finite b, Eq b, Show b) =>
Hedgehog.PropertyT m ()
check = do
x :: a <- Hedgehog.forAll Gen.integral
let x' = Num.toInteger x
let ok = x' Ord.>= Num.toInteger (Bounded.minBound :: b) Bool.&&
x' Ord.<= Num.toInteger (Bounded.maxBound :: b)
(Integer.toFinite x :: Maybe b) ===
if ok then Just (Num.fromInteger x') else Nothing
it "A = Integer, B = Int " $ hedgehog $ check @Integer @Int
it "A = Integer, B = Word" $ hedgehog $ check @Integer @Word
it "A = Natural, B = Int " $ hedgehog $ check @Natural @Int
it "A = Natural, B = Word" $ hedgehog $ check @Natural @Word
it "A = Positive, B = Int " $ hedgehog $ check @Positive @Int
it "A = Positive, B = Word" $ hedgehog $ check @Positive @Word
it "A = Signed, B = Int " $ hedgehog $ check @Signed @Int
it "A = Signed, B = Word" $ hedgehog $ check @Signed @Word
describe "fromFinite x = narrow (toInteger x)" do
let check :: forall a b m. Monad m =>
(ConvertWithFinite a, IntegerNarrow Integer a, Eq a, Show a) =>
(Finite b, GenFinite b, Show b) =>
Hedgehog.PropertyT m ()
check = do
x :: b <- Hedgehog.forAll Gen.finite
(Integer.fromFinite x :: Maybe a) === Integer.narrow (Num.toInteger x)
it "A = Int, B = Integer " $ hedgehog $ check @Integer @Int
it "A = Word, B = Integer" $ hedgehog $ check @Integer @Word
it "A = Int, B = Natural " $ hedgehog $ check @Natural @Int
it "A = Word, B = Natural" $ hedgehog $ check @Natural @Word
it "A = Int, B = Positive " $ hedgehog $ check @Positive @Int
it "A = Word, B = Positive" $ hedgehog $ check @Positive @Word
it "A = Int, B = Signed " $ hedgehog $ check @Signed @Int
it "A = Word, B = Signed" $ hedgehog $ check @Signed @Word
describe "Enum @Positive" $ do
describe "[a ..]" $ do
it "counts upward" $
take 3 [5 :: Positive ..] `shouldBe` [5, 6, 7]
it "can start with 1" $
take 3 [1 :: Positive ..] `shouldBe` [1, 2, 3]
describe "[a .. b]" $ do
it "counts upward" $
[5 .. 8 :: Positive] `shouldBe` [5, 6, 7, 8]
it "can start with 1" $
[1 .. 5 :: Positive] `shouldBe` [1, 2, 3, 4, 5]
it "does not count downward" $ do
[8 .. 5 :: Positive] `shouldBe` []
[8 .. 7 :: Positive] `shouldBe` []
it "can return 1 item" $ do
[3 .. 3 :: Positive] `shouldBe` [3]
[1 .. 1 :: Positive] `shouldBe` [1]
describe "[a, b ..]" $ do
it "can count upward by 1" $ do
take 5 [5, 6 :: Positive ..] `shouldBe` [5, 6, 7, 8, 9]
take 5 [1, 2 :: Positive ..] `shouldBe` [1, 2, 3, 4, 5]
it "can count downward by 1" $
[5, 4 :: Positive ..] `shouldBe` [5, 4, 3, 2, 1]
it "can count upward by 2" $ do
take 5 [5, 7 :: Positive ..] `shouldBe` [5, 7, 9, 11, 13]
take 5 [1, 3 :: Positive ..] `shouldBe` [1, 3, 5, 7, 9]
it "can count downward by 2" $
[9, 7 :: Positive ..] `shouldBe` [9, 7, 5, 3, 1]
it "can count downward by 2 without exactly reaching its lower bound" $
[8, 6 :: Positive ..] `shouldBe` [8, 6, 4, 2]
it "can repeat 1 item indefinitely" $
take 5 [4, 4 :: Positive ..] `shouldBe` [4, 4, 4, 4, 4]
describe "[a, b .. c]" $ do
it "can count upward by 1" $ do
[5, 6 .. 9 :: Positive] `shouldBe` [5, 6, 7, 8, 9]
[1, 2 .. 5 :: Positive] `shouldBe` [1, 2, 3, 4, 5]
it "can count downward by 1" $
[9, 8 .. 5 :: Positive] `shouldBe` [9, 8, 7, 6, 5]
it "can count upward by 2" $ do
[5, 7 .. 11 :: Positive] `shouldBe` [5, 7, 9, 11]
[1, 3 .. 7 :: Positive] `shouldBe` [1, 3, 5, 7]
it "can count upward without exactly reaching its upper bound" $
[5, 7 .. 12 :: Positive] `shouldBe` [5, 7, 9, 11]
it "can count downward by 2" $
[11, 9 .. 5 :: Positive] `shouldBe` [11, 9, 7, 5]
it "can count downward by 2 without exactly reaching its lower bound" $
[11, 9 .. 4 :: Positive] `shouldBe` [11, 9, 7, 5]
it "can count downward with a lower bound of 1" $ do
[7, 5 .. 1 :: Positive] `shouldBe` [7, 5, 3, 1]
[8, 6 .. 1 :: Positive] `shouldBe` [8, 6, 4, 2]
it "can repeat 1 item indefinitely" $ do
take 5 [4, 4 .. 9 :: Positive] `shouldBe` [4, 4, 4, 4, 4]
take 5 [4, 4 .. 4 :: Positive] `shouldBe` [4, 4, 4, 4, 4]
it "can return 1 item" $ do
[4, 5 .. 4 :: Positive] `shouldBe` [4]
[4, 3 .. 4 :: Positive] `shouldBe` [4]
it "can return an empty list" $ do
[4, 4 .. 3 :: Positive] `shouldBe` []
[4, 5 .. 3 :: Positive] `shouldBe` []
[5, 4 .. 6 :: Positive] `shouldBe` []
describe "deepseq @Signed" $ do
it "can succeed" $ do
x <- force (NonZero MinusSign 5)
x `shouldBe` Right (-5)
it "can force an error" $ do
x <- force (throw X :: Signed)
x `shouldBe` Left X
it "can force an error in sign" $ do
x <- force (NonZero (throw X) 5)
x `shouldBe` Left X
it "can force an error in magnitude" $ do
x <- force (NonZero MinusSign (throw X))
x `shouldBe` Left X
data X = X
deriving (Eq, Show)
instance Exception X
force :: NFData a => Exception.MonadCatch m => a -> m (Either X a)
force x = Exception.try (pure $!! x)