packages feed

speculate 0.2.8 → 0.2.9

raw patch · 6 files changed

+50/−29 lines, 6 files

Files

speculate.cabal view
@@ -1,5 +1,5 @@ name:                speculate-version:             0.2.8+version:             0.2.9 synopsis:            discovery of properties about Haskell functions description:   Speculate automatically discovers laws about Haskell functions.@@ -31,7 +31,7 @@ source-repository this   type:            git   location:        https://github.com/rudymatela/speculate-  tag:             v0.2.8+  tag:             v0.2.9   library
src/Test/Speculate/Expr/Equate.hs view
@@ -17,6 +17,7 @@   ( equation, unEquation, isEquation, uselessEquation, usefulEquation   , phonyEquation +  , inequality   , comparisonLT, comparisonLE, unComparison    , implication, unImplication, usefulImplication@@ -61,6 +62,11 @@  usefulEquation :: Expr -> Bool usefulEquation = uncurry (/=) . unEquation++inequality :: Instances -> Expr -> Expr -> Maybe Expr+inequality ti e1 e2 = do+  e <- iqE ti (typ e1)+  e :$ e1 $$ e2  comparisonLT :: Instances -> Expr -> Expr -> Maybe Expr comparisonLT ti e1 e2 = do
src/Test/Speculate/Expr/Instance.hs view
@@ -25,7 +25,7 @@   , instanceType   , findInfo   , names-  , eqE,      isEq,       isEqE+  , eqE, iqE, isEq,       isEqE   , leE, ltE, isOrd,      isOrdE   ,           isEqOrd,    isEqOrdE   , tiersE,   isListable@@ -133,7 +133,8 @@  eqWith :: (Typeable a, Eq a) => (a -> a -> Bool) -> Instances eqWith (==) = [ Instance "Eq" (typeOf $ arg (==))-                  [constant "==" $ errorToFalse .: (==)] ]+                  [ constant "==" $ errorToFalse .: (==)+                  , constant "/=" $ (errorToFalse . not) .: (==)] ]   where   arg :: (a -> b) -> a   arg _ = undefined@@ -198,8 +199,14 @@ eqE :: Instances -> TypeRep -> Maybe Expr eqE ti t = findInfo m ti   where-  m (Instance "Eq" t' [eq]) | t == t' = Just eq-  m _                                 = Nothing+  m (Instance "Eq" t' [eq,_]) | t == t' = Just eq+  m _                                   = Nothing++iqE :: Instances -> TypeRep -> Maybe Expr+iqE ti t = findInfo m ti+  where+  m (Instance "Eq" t' [_,iq]) | t == t' = Just iq+  m _                                   = Nothing  ltE :: Instances -> TypeRep -> Maybe Expr ltE ti t = findInfo m ti
tests/Test.hs view
@@ -74,7 +74,7 @@   , true, false   , pp, qq, rr   , not', (-&&-), (-||-), (-==>-)-  , (-==-), (-<=-), (-<-)+  , (-==-), (-/=-), (-<=-), (-<-)   , odd', even'    -- ** Characters@@ -489,6 +489,12 @@   fromMaybe (error $ "(-==-): cannot equate " ++ show e1 ++ " and " ++ show e2)             (equation preludeInstances e1 e2) infix 4 -==-++(-/=-) :: Expr -> Expr -> Expr+e1 -/=- e2 =+  fromMaybe (error $ "(-/=-): cannot inequate " ++ show e1 ++ " and " ++ show e2)+            (inequality preludeInstances e1 e2)+infix 4 -/=-  (-<=-) :: Expr -> Expr -> Expr e1 -<=- e2 =
tests/test-eval.hs view
@@ -43,6 +43,11 @@   , trueBinds preludeInstances 500 (xx -==- zero) == [[("x",zero)]]   , trueBinds preludeInstances 500 (xx -==- one)  == [[("x",one)]]   , trueBinds preludeInstances 500 ((xx -==- one) -&&- (yy -==- zero))  == [[("x",one),("y",zero)]]++  , holds n $ ordOK -:> int+  , holds n $ ordOK -:> ()+  , holds n $ ordOK -:> bool+  , holds n $ ordOK -:> [int]   ]   where   n' = n `div` 50@@ -51,3 +56,18 @@   x =/= y = not (x === y)   infix 4 =/=   x //= y = inequal preludeInstances 500 x y++(*==*), (*/=*), (*<=*), (*<*) :: (Show a, Typeable a) => a -> a -> Bool+x *==* y = eval undefined $ showConstant x -==- showConstant y+x */=* y = eval undefined $ showConstant x -/=- showConstant y+x *<=* y = eval undefined $ showConstant x -<=- showConstant y+x *<*  y = eval undefined $ showConstant x -<-  showConstant y++eqOK :: (Eq a, Show a, Typeable a) => a -> a -> Bool+eqOK x y =  (x *==* y) == (x == y)+         && (x */=* y) == (x /= y)++ordOK :: (Eq a, Ord a, Show a, Typeable a) => a -> a -> Bool+ordOK x y =  eqOK x y+          && (x *<=* y) == (x <= y)+          && (x *<*  y) == (x <  y)
tests/test-expr.hs view
@@ -74,6 +74,10 @@   , absE < timesE   , aa   < ordE   , ordE < timesE+  , constant "id" (id -:>  int)  < constant "id"    (id    -:>  [int])+  , constant "id" (id -:> [int]) < constant "id"    (id    -:> [[int]])+  , constant "id" (id -:>  int)  < constant "sum"   (sum   -:>  [int])+  , constant "id" (id -:>  int)  < constant "(:[])" ((:[]) -:>   int)    -- precedent types   , pp < xx@@ -174,28 +178,6 @@   , xx < yy   , zero < one   , xx < zero--{- -- commenting out as those tests are causing more harm than good.-  -- If those two ever fail, it is because the instance for Ord TypeRep in-  -- Data.Typeable has changed.  I do rely on this for a "nice" knuth-bendix-  -- order (by prefering less arity).  If this ever changes, I will have to-  -- explicitly compare type arity on Ord Expr.-  -- (update: haha! It has changed from before, and twice, and thrice!)-  -- TODO: fix order under GHC <= 7.8-#if __GLASGOW_HASKELL__ < 706-  , typeOf ((+) :: Int -> Int -> Int) > typeOf (abs :: Int -> Int)-  , typeOf (abs :: Int -> Int)        < typeOf (0 :: Int)-#elif __GLASGOW_HASKELL__ < 800-  , typeOf ((+) :: Int -> Int -> Int) < typeOf (abs :: Int -> Int)-  , typeOf (abs :: Int -> Int)        < typeOf (0 :: Int)-#elif __GLASGOW_HASKELL__ < 802-  , typeOf ((+) :: Int -> Int -> Int) > typeOf (abs :: Int -> Int)-  , typeOf (abs :: Int -> Int)        > typeOf (0 :: Int)-#else-  , typeOf ((+) :: Int -> Int -> Int) < typeOf (abs :: Int -> Int)-  , typeOf (abs :: Int -> Int)        > typeOf (0 :: Int)-#endif--}    , holds n $ \(IntE e1) (IntE e2) -> isTuple (pair e1 e2)                                    && unfoldTuple (pair e1 e2) == [e1,e2]