fucking bullshit

Author: MaximilianAlgehed

src/Constrained/NumOrd.hs

@@ -730,13 +730,38 @@ instance {-# OVERLAPPABLE #-} (HasSpec a, Integral a, TypeSpec a ~ NumSpec a) =>
   doDivide = div
 
   divideSpec 0 _ = TrueSpec
-  divideSpec a (NumSpecInterval ml mu) = typeSpec $ NumSpecInterval (((`div`a) . (+1)) <$> ml) ((`div`a) <$> mu)
+  -- TODO This is all wrong and hence the tests are all wrong
+  divideSpec a (NumSpecInterval ml mu) = typeSpec ts
+    where
+      ts | a > 0 = NumSpecInterval ml' mu'
+         | otherwise = NumSpecInterval mu' ml'
+      ml' = adjustLowerBound <$> ml
+      mu' = adjustUpperBound <$> mu
+      adjustLowerBound l =
+        let r = l `div` a in
+        if r * a < l
+        then r + 1
+        else r
+
+      adjustUpperBound u =
+        let r = u `div` a in
+        if r * a > u
+        then r - 1
+        else r
 
 instance HasDivision Float where
   doDivide = (/)
 
   divideSpec 0 _ = TrueSpec
-  divideSpec a (NumSpecInterval ml mu) = typeSpec $ NumSpecInterval ((/a) <$> ml) ((/a) <$> mu)
+  divideSpec a (NumSpecInterval ml mu) = typeSpec ts
+    where
+      ts | a > 0 = NumSpecInterval ml' mu'
+         | otherwise = NumSpecInterval mu' ml'
+      ml' = adjustLowerBound <$> ml
+      mu' = adjustUpperBound <$> mu
+      adjustLowerBound l = l / a
+
+      adjustUpperBound u = u / a
 
 instance HasDivision Double where
   doDivide = (/)

src/Constrained/Test.hs

@@ -326,6 +326,10 @@ instance (HasSpec a, Arbitrary (TypeSpec a)) => Arbitrary (Specification a) wher
       , (10, pure baseSpec)
       ]
 
+  shrink (TypeSpec ts cant) = flip TypeSpec cant <$> shrink ts
+  shrink (ExplainSpec _ s) = [s]
+  shrink _ = []
+
 instance
   ( Arbitrary a
   , Arbitrary (FoldSpec a)