[#5] Num laws for Size

slist.cabal

@@ -71,4 +71,18 @@ test-suite slist-doctest
   main-is:             Doctest.hs
   build-depends:       doctest
                      , Glob
-  ghc-options:         -threaded
+  ghc-options:         -threaded
+
+test-suite slist-test
+  import:              common-options
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  other-modules:       Test.Slist.Size
+  build-depends:       slist
+                     , hedgehog ^>= 1.0
+                     , hspec
+                     , hspec-hedgehog ^>= 0.0.1
+  ghc-options:         -threaded
+                       -rtsopts
+                       -with-rtsopts=-N

src/Slist/Size.hs

@@ -36,15 +36,28 @@ data Size
 
 {- | Efficient implementations of numeric operations with 'Size's.
 
-Any operations with 'Infinity' size results into 'Infinity'.
-
-TODO: checking on overflow when '+' or '*' sizes.
+Any operations with 'Infinity' size results into 'Infinity'. When
+'Infinity' is a left argument, all operations are also
+right-lazy. Operations are checked for integral overflow under the
+assumption that all values inside 'Size' are positive.
+
+>>> Size 10 + Size 5
+Size 15
+>>> Size 5 * Infinity
+Infinity
+>>> Infinity + error "Unevaluated size"
+Infinity
+>>> Size (10 ^ 10) * Size (10 ^ 10)
+Infinity
 -}
 instance Num Size where
     (+) :: Size -> Size -> Size
     Infinity + _ = Infinity
     _ + Infinity = Infinity
-    (Size x) + (Size y) = Size $ x + y
+    (Size x) + (Size y) =
+        if x + y < x  -- integer overflow
+        then Infinity
+        else Size $ x + y
     {-# INLINE (+) #-}
 
     (-) :: Size -> Size -> Size
@@ -56,7 +69,13 @@ instance Num Size where
     (*) :: Size -> Size -> Size
     Infinity * _ = Infinity
     _ * Infinity = Infinity
-    (Size x) * (Size y) = Size (x * y)
+    (Size x) * (Size y)
+        | x == 0 || y == 0 = 0
+        | otherwise =
+            let result = x * y in
+            if x == result `div` y
+            then Size (x * y)
+            else Infinity  -- multiplication overflow
     {-# INLINE (*) #-}
 
     abs :: Size -> Size

stack.yaml

@@ -1 +1 @@
-resolver: nightly-2019-11-08
+resolver: nightly-2020-05-01

test/Spec.hs

@@ -0,0 +1,9 @@
+module Main (main) where
+
+import Test.Hspec (hspec)
+
+import Test.Slist.Size (sizeSpec)
+
+
+main :: IO ()
+main = hspec sizeSpec

test/Test/Slist/Size.hs

@@ -0,0 +1,95 @@
+{- HLINT ignore "Redundant fromInteger" -}
+{- HLINT ignore "Reduce duplication" -}
+
+module Test.Slist.Size
+    ( sizeSpec
+    ) where
+
+import Hedgehog (Gen, PropertyT, forAll, (===))
+import Test.Hspec (Spec, describe, it)
+import Test.Hspec.Hedgehog (hedgehog)
+
+import Slist.Size (Size (..))
+
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+
+
+type Property = PropertyT IO ()
+
+sizeSpec :: Spec
+sizeSpec = describe "Size tests" $
+    describe "'Num' laws" $ do
+        it "Neutrality of 0 over addition" zeroAdditionNeutrality
+        it "Commutativity of (+)" additionCommutativity
+        it "Associativity of (+)" additionAssotiavity
+        it "Neutrality of 1 over multiplication" oneMultiplicationNeutrality
+        it "Commutativity of (*)" multiplicationCommutavity
+        it "Associativity of (*)" multiplicationAssociativity
+        it "Distributivity of (*) with respect to (+)" distributivity
+        it "'abs' and 'signum' correspondence" absSignum
+
+zeroAdditionNeutrality :: Property
+zeroAdditionNeutrality = hedgehog $ do
+    x <- forAll genSize
+
+    fromInteger 0 + x === x
+    x + fromInteger 0 === x
+
+additionCommutativity :: Property
+additionCommutativity = hedgehog $ do
+    x <- forAll genSize
+    y <- forAll genSize
+
+    x + y === y + x
+
+additionAssotiavity :: Property
+additionAssotiavity = hedgehog $ do
+    x <- forAll genSize
+    y <- forAll genSize
+    z <- forAll genSize
+
+    (x + y) + z === x + (y + z)
+
+oneMultiplicationNeutrality :: Property
+oneMultiplicationNeutrality = hedgehog $ do
+    x <- forAll genSize
+
+    fromInteger 1 * x === x
+    x * fromInteger 1 === x
+
+multiplicationCommutavity :: Property
+multiplicationCommutavity = hedgehog $ do
+    x <- forAll genSize
+    y <- forAll genSize
+
+    x * y === y * x
+
+multiplicationAssociativity :: Property
+multiplicationAssociativity = hedgehog $ do
+    x <- forAll genSize
+    y <- forAll genSize
+    z <- forAll genSize
+
+    (x * y) * z === x * (y * z)
+
+distributivity :: Property
+distributivity = hedgehog $ do
+    x <- forAll genSize
+    y <- forAll genSize
+    z <- forAll genSize
+
+    x * (y + z) === (x * y) + (x * z)
+    (y + z) * x === (y * x) + (z * x)
+
+absSignum :: Property
+absSignum = hedgehog $ do
+    x <- forAll genSize
+
+    abs x * signum x === x
+
+genSize :: Gen Size
+genSize = Gen.frequency
+    [ (1, pure Infinity)
+    , (9, Size <$> Gen.int (Range.constant 0 maxBound))
+    ]