packages feed

extrapolate 0.2.3 → 0.2.4

raw patch · 11 files changed

+419/−24 lines, 11 filesdep ~leancheckdep ~speculatePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: leancheck, speculate

API changes (from Hackage documentation)

+ Test.Extrapolate.Core: (*/=*) :: Generalizable a => a -> a -> Bool
+ Test.Extrapolate.Core: (*<*) :: Generalizable a => a -> a -> Bool
+ Test.Extrapolate.Core: (*<=*) :: Generalizable a => a -> a -> Bool
+ Test.Extrapolate.Core: bgEqWith1 :: (Generalizable a, Generalizable b) => ((b -> b -> Bool) -> a -> a -> Bool) -> [Expr]
+ Test.Extrapolate.Core: bgEqWith2 :: (Generalizable a, Generalizable b, Generalizable c) => ((b -> b -> Bool) -> (c -> c -> Bool) -> a -> a -> Bool) -> [Expr]
+ Test.Extrapolate.Core: counterExamples :: Testable a => Int -> a -> [[Expr]]
+ Test.Extrapolate.Exprs: type Exprs = [Expr]
+ Test.Extrapolate.New: generalizedCounterExamples :: Testable a => Int -> a -> [Exprs]
+ Test.Extrapolate.New: lgg :: Exprs -> Exprs -> Exprs
+ Test.Extrapolate.New: lgg1 :: Expr -> Expr -> Expr
+ Test.Extrapolate.Utils: (.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
+ Test.Extrapolate.Utils: eitherEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
+ Test.Extrapolate.Utils: eitherOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
+ Test.Extrapolate.Utils: listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool
+ Test.Extrapolate.Utils: listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool
+ Test.Extrapolate.Utils: maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
+ Test.Extrapolate.Utils: maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool

Files

TODO.md view
@@ -99,6 +99,45 @@   only do vassignments *after* finding a failing single variable instance.   I'll have to re-test, but the time I save may pay off. +* `new-lgg-algorithm`:++  This is just a sketch:++  1. test and keep all tests that pass and fail++  2. pick first counter-example, note that it does not match any of the passing+     tests++  3. first counter-example is current generalization++  4. compute lgg of current generalization with the next counter-example++  5. if it does not matches any of the passing tests, update current generalization++  6. go to 4++  7. generalize to several variables++  Variation of steps 4 and 5 with conditions:++  4. compute lgg of current generaliation with the next counter-example,+     find weakest condition for it to hold++  5. if lgg matches 10% of failing tests, update current generalization.++  The variation may have trouble when dealing with multiple variables,+  maybe there should be a multi-lgg, or start with all vars different++  After some tests, I see that this does not quite work as expected.  c.f.+  `union xs ys == union ys xs`. When incorporating a counterExampe, sometimes+  the generalization will temporarily match some passing tests, only to be+  later weeded out by some other counter-example.  There are many many more+  combinations of counterexamples 2^#nce then there are candidate+  generalizations of the smallest counter-example (at least in the worst case,+  maybe there is a property here that I am not seeing).+++ won't fix ---------
extrapolate.cabal view
@@ -1,5 +1,5 @@ name:                extrapolate-version:             0.2.3+version:             0.2.4 synopsis:            generalize counter-examples of test properties description:   Extrapolate is a tool able to provide generalized counter-examples of test@@ -31,7 +31,7 @@ source-repository this   type:            git   location:        https://github.com/rudymatela/speculate-  tag:             v0.2.3+  tag:             v0.2.4  library   exposed-modules: Test.Extrapolate@@ -42,11 +42,12 @@                  , Test.Extrapolate.IO                  , Test.Extrapolate.TypeBinding                  , Test.Extrapolate.Utils+                 , Test.Extrapolate.New   other-extensions:    TemplateHaskell, CPP   build-depends: base >= 4 && < 5                , leancheck >= 0.6.5                , template-haskell-               , speculate >= 0.2.8+               , speculate >= 0.2.9   hs-source-dirs:      src   default-language:    Haskell2010 @@ -69,6 +70,14 @@ test-suite utils   type:                exitcode-stdio-1.0   main-is:             test-utils.hs+  other-modules:       Test+  hs-source-dirs:      tests+  build-depends:       base >= 4 && < 5, leancheck, speculate, extrapolate+  default-language:    Haskell2010++test-suite new+  type:                exitcode-stdio-1.0+  main-is:             test-new.hs   other-modules:       Test   hs-source-dirs:      tests   build-depends:       base >= 4 && < 5, leancheck, speculate, extrapolate
src/Test/Extrapolate/Basic.hs view
@@ -12,10 +12,12 @@ -- luck importing "Test.Extrapolate" directly. module Test.Extrapolate.Basic   ( module Test.Extrapolate.Core+  , module Test.Extrapolate.New   ) where  import Test.Extrapolate.Core+import Test.Extrapolate.New import Data.Ratio  instance (Integral a, Generalizable a) => Generalizable (Ratio a) where
src/Test/Extrapolate/Core.hs view
@@ -21,6 +21,8 @@   , backgroundOf   , bgEq   , bgOrd+  , bgEqWith1+  , bgEqWith2    , Option (..)   , WithOption (..)@@ -29,7 +31,11 @@   , maxConditionSize   , hasEq   , (*==*)+  , (*/=*)+  , (*<=*)+  , (*<*) +  , counterExamples   , counterExampleGen   , counterExampleGens @@ -152,7 +158,9 @@   expr mx@Nothing   =  constant "Nothing" (Nothing -: mx)   expr mx@(Just x)  =  constant "Just"    (Just   ->: mx) :$ expr x   name mx = "m" ++ name (fromJust mx)-  background mx  =  [ constant "Just"    (Just   ->: mx) ]+  background mx  =  [ constant "Just" (Just ->: mx) ]+                 ++ bgEqWith1  (maybeEq  ->:> mx)+                 ++ bgOrdWith1 (maybeOrd ->:> mx)   instances mx  =  this mx $ instances (fromJust mx)  instance (Generalizable a, Generalizable b) => Generalizable (Either a b) where@@ -161,6 +169,8 @@   name exy = "e" ++ name (fromLeft exy) ++ name (fromRight exy)   background exy  =  [ constant "Left"  (Left  ->: exy)                      , constant "Right" (Right ->: exy) ]+                  ++ bgEqWith2  (eitherEq  ->>:> exy)+                  ++ bgOrdWith2 (eitherOrd ->>:> exy)   instances exy  =  this exy $ instances (fromLeft  exy)                              . instances (fromRight exy) @@ -197,10 +207,10 @@   expr (xs@[])      =  showConstant  ([]    -: xs)   expr (xs@(y:ys))  =  constant ":"  ((:) ->>: xs) :$ expr y :$ expr ys   background xs  =  [ constant "length" (length -:> xs) ]-                 ++ [ constant "elem" (elemBy (*==*) ->:> xs) | hasEq (head xs) ]+                 ++ [ constant "elem"      (elemBy (*==*) ->:> xs) | hasEq $ head xs ]+                 ++ bgEqWith1  (listEq  ->:> xs)+                 ++ bgOrdWith1 (listOrd ->:> xs)   instances xs  =  this xs $ instances (head xs)--- TODO: add (==) and (/=) when list element type has (==) and (/=)--- TODO: add (<=) and (<)  when list element type has (<=) and (<)  instance Generalizable Ordering where   name o  =  "o"@@ -218,6 +228,40 @@           , constant "<"  ((<)  -:> x)           , constant "<=" ((<=) -:> x) ] +bgEqWith1 :: (Generalizable a, Generalizable b)+          => ((b -> b -> Bool) -> a -> a -> Bool) -> [Expr]+bgEqWith1 makeEq = takeWhile (\_ -> hasEq x)+                 [ constant "==" (       makeEq (*==*))+                 , constant "/=" (not .: makeEq (*==*)) ]+  where+  x = argTy1of2 $ argTy1of2 makeEq++bgEqWith2 :: (Generalizable a, Generalizable b, Generalizable c)+          => ((b -> b -> Bool) -> (c -> c -> Bool) -> a -> a -> Bool) -> [Expr]+bgEqWith2 makeEq = takeWhile (\_ -> hasEq x && hasEq y)+                 [ constant "==" (       makeEq (*==*) (*==*))+                 , constant "/=" (not .: makeEq (*==*) (*==*)) ]+  where+  x = argTy1of2 $ argTy1of2 makeEq+  y = argTy1of2 . argTy1of2 $ argTy2of2 makeEq++bgOrdWith1 :: (Generalizable a, Generalizable b)+          => ((b -> b -> Bool) -> a -> a -> Bool) -> [Expr]+bgOrdWith1 makeOrd = takeWhile (\_ -> hasOrd x)+                   [ constant "<=" (             makeOrd (*<=*))+                   , constant "<"  (not .: flip (makeOrd (*<*))) ]+  where+  x = argTy1of2 $ argTy1of2 makeOrd++bgOrdWith2 :: (Generalizable a, Generalizable b, Generalizable c)+          => ((b -> b -> Bool) -> (c -> c -> Bool) -> a -> a -> Bool) -> [Expr]+bgOrdWith2 makeOrd = takeWhile (\_ -> hasOrd x && hasOrd y)+                   [ constant "<=" (             makeOrd (*<=*) (*<=*))+                   , constant "<"  (not .: flip (makeOrd (*<=*) (*<=*))) ]+  where+  x = argTy1of2 $ argTy1of2 makeOrd+  y = argTy1of2 . argTy1of2 $ argTy2of2 makeOrd+ -- | Usage: @ins "x" (undefined :: Type)@ ins :: Generalizable a => a -> Instances ins x = listable x +++ nameWith (name x) x +++ backgroundWith (background x) x@@ -478,19 +522,39 @@ isVar (Var _ _) = True isVar _         = False +fromBackgroundOf :: (Generalizable a, Typeable b) => String -> a -> Maybe b+fromBackgroundOf nm = listToMaybe+                    . catMaybes+                    . map evaluate+                    . filter (`isConstantNamed` nm)+                    . background+ hasEq :: Generalizable a => a -> Bool hasEq x = isJust $ "==" `fromBackgroundOf` x -: mayb (x >- x >- bool) +hasOrd :: Generalizable a => a -> Bool+hasOrd x = isJust $ "<=" `fromBackgroundOf` x -: mayb (x >- x >- bool)+ (*==*) :: Generalizable a => a -> a -> Bool x *==* y = x == y   where   (==) = fromMaybe (error "(*==*): no (==) operator in background")        $ "==" `fromBackgroundOf` x--- TODO: rename (*==*) to (-==-), use it in the Test module. -fromBackgroundOf :: (Generalizable a, Typeable b) => String -> a -> Maybe b-fromBackgroundOf nm = listToMaybe-                    . catMaybes-                    . map evaluate-                    . filter (`isConstantNamed` nm)-                    . background+(*/=*) :: Generalizable a => a -> a -> Bool+x */=* y = x /= y+  where+  (/=) = fromMaybe (error "(*/=*): no (/=) operator in background")+       $ "/=" `fromBackgroundOf` x++(*<=*) :: Generalizable a => a -> a -> Bool+x *<=* y = x <= y+  where+  (<=) = fromMaybe (error "(*<=*): no (<=) operator in background")+       $ "<=" `fromBackgroundOf` x++(*<*) :: Generalizable a => a -> a -> Bool+x *<* y = x < y+  where+  (<) = fromMaybe (error "(*<*): no (<) operator in background")+       $ "<" `fromBackgroundOf` x
src/Test/Extrapolate/Exprs.hs view
@@ -12,7 +12,8 @@ -- instead of working on single expressions it works in lists of expressions -- (the choosen representation for counter-examples). module Test.Extrapolate.Exprs-  ( canonicalizeWith+  ( Exprs+  , canonicalizeWith   , grounds   , groundsAndBinds   , vassignments@@ -39,6 +40,8 @@ import Test.LeanCheck.Error (errorToFalse) import Data.Typeable (typeOf, TypeRep, Typeable) import Data.List ((\\))++type Exprs = [Expr]  nameWith :: Typeable a => String -> a -> Instances nameWith = E.name
+ src/Test/Extrapolate/New.hs view
@@ -0,0 +1,55 @@+-- |+-- This module is otherwise unused in the code.+--+-- This is a stub of a new algorithm that is smarter and generalizes from+-- several initial counter-examples rather than just one.+--+-- When this gets finished, it should be moved into "Test.Extrapolate.Core".+module Test.Extrapolate.New+  ( generalizedCounterExamples+  , lgg+  , lgg1+  )+where++import Test.Extrapolate.Core+++-- This is not the actual function used to generate generalizedCounterExamples.+-- It is otherwise unused elsewhere in the code.  It is a sketch of a new+-- version.  Please see counterExampleGens and generalizationsCE to see how it+-- works _now_.+generalizedCounterExamples :: Testable a => Int -> a -> [Exprs]+generalizedCounterExamples n p = gce $ counterExamples n p+  where+  passes = [as | (as,True) <- take n (results p)]+  gce :: [Exprs] -> [Exprs]+  gce []     = []+  gce (e:es) = foldr1 incorporate (e:es)+             : gce es+  incorporate :: Exprs -> Exprs -> Exprs+  g `incorporate` e = let g' = lgg g e+                      in if not $ any (`areInstancesOf` g') passes+                         then g'+                         else g+++-- | Computes the least general generalization of two expressions+--+-- > lgg1 (expr [0,0]) (expr [1,1])+-- [_,_] :: [Int]  (holes: Int, Int)+-- > lgg1 (expr [1,1::Int]) (expr [2,2,2::Int])+-- _:_:_ :: [Int]  (holes: Int, Int, [Int])+lgg1 :: Expr -> Expr -> Expr+lgg1 e1 e2 | typ e1 /= typ e2  =+  error $ "lgg1: type mismatch: " ++ show e1 ++ ", " ++ show e2+lgg1 (e1f :$ e1x) (e2f :$ e2x)  |  typ e1f == typ e2f+                                && typ e1x == typ e2x+                                =  lgg1 e1f e2f :$ lgg1 e1x e2x+lgg1 e1@(Var _ _) _  =  e1+lgg1 _ e2@(Var _ _)  =  e2+lgg1 e1 e2 | e1 == e2   =  e1+           | otherwise  =  holeOfTy $ typ e1++lgg :: Exprs -> Exprs -> Exprs+lgg = zipWith lgg1
src/Test/Extrapolate/Utils.hs view
@@ -21,6 +21,10 @@   , fromLeft   , fromRight   , elemBy+  , listEq,   listOrd+  , maybeEq,  maybeOrd+  , eitherEq, eitherOrd+  , (.:)   ) where @@ -60,3 +64,45 @@  elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool elemBy (==) x = any (== x)++listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool+listEq (==) []     []     = True+listEq (==) (x:xs) []     = False+listEq (==) []     (y:ys) = False+listEq (==) (x:xs) (y:ys) = x == y && listEq (==) xs ys++listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool+listOrd (<=) []     []     = True+listOrd (<=) (x:xs) []     = False+listOrd (<=) []     (y:ys) = True+listOrd (<=) (x:xs) (y:ys) = x <  y+                          || x == y && listOrd (<=) xs ys+  where+  x <  y = x <= y && not (y <= x)+  x == y = x <= y &&      y <= x++maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool+maybeEq (==) Nothing  Nothing  = True+maybeEq (==) Nothing  (Just y) = False+maybeEq (==) (Just x) Nothing  = False+maybeEq (==) (Just x) (Just y) = x == y++maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool+maybeOrd (<=) Nothing  Nothing  = True+maybeOrd (<=) Nothing  (Just y) = True+maybeOrd (<=) (Just x) Nothing  = False+maybeOrd (<=) (Just x) (Just y) = x <= y++eitherEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool+eitherEq (==) _ (Left  x) (Left  y) = x == y+eitherEq _ (==) (Right x) (Right y) = x == y+eitherEq _ _ _ _ = False++eitherOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool+eitherOrd (<=) _ (Left  x) (Left  y) = x <= y+eitherOrd _ (<=) (Right x) (Right y) = x <= y+eitherOrd _    _ (Left  _) (Right _) = True+eitherOrd _    _ (Right _) (Left  _) = False++(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)+(.:) = (.) . (.)
tests/Test.hs view
@@ -10,10 +10,11 @@   , mainTest   , printLines -  , (-:-), ll, llb+  , (-:-), ll, llb, llmi    , _i, xx, yy   , _is, xxs, yys+  , _mi, mxx   , zero, one    , false, true@@ -53,6 +54,7 @@ import Data.Maybe (fromMaybe)  import Test.Extrapolate+import Test.Extrapolate.Utils import Test.Extrapolate.Core hiding (false, true) import qualified Test.Extrapolate.Core as Core import Test.LeanCheck.Utils.Operators@@ -83,11 +85,13 @@ x -:- xs  =  consE :$ x :$ xs   where   consE = case show $ typ x of-            "Int"  -> consEint-            "Bool" -> consEbool-            t      -> error $ "(-:-): unhandled type " ++ t+            "Int"       -> consEint+            "Bool"      -> consEbool+            "Maybe Int" -> consEmint+            t           -> error $ "(-:-): unhandled type " ++ t   consEint   =  constant ":" ((:) -:> int)   consEbool  =  constant ":" ((:) -:> bool)+  consEmint  =  constant ":" ((:) -:> mayb int) infixr 5 -:-  ll :: Expr@@ -103,6 +107,10 @@ xxs  =  var "xs" [int] yys  =  var "ys" [int] +_mi, mxx :: Expr+_mi  =  var ""   (mayb int)+mxx  =  var "mx" (mayb int)+ zero :: Expr zero  =  expr (0 :: Int) @@ -112,6 +120,9 @@ llb :: Expr llb  =  expr ([] :: [Bool]) +llmi :: Expr+llmi  =  expr ([] :: [Maybe Int])+ false :: Expr false  =  expr False @@ -160,9 +171,10 @@ infix 4 -==-  (-/=-) :: Expr -> Expr -> Expr-e1 -/=- e2 = constant "/=" ((/=) :: Int -> Int -> Bool) :$ e1 :$ e2+e1 -/=- e2 =+  fromMaybe (error $ "(-/=-): cannot inequate " ++ show e1 ++ " and " ++ show e2)+            (inequality preludeInstances e1 e2) infix 4 -/=---- TODO: improve above after changing Speculate  (-<=-) :: Expr -> Expr -> Expr e1 -<=- e2 =
tests/test-extrapolate.hs view
@@ -1,10 +1,25 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, CPP #-} -- for GHC <= 7.8 -- Copyright (c) 2017 Rudy Matela. -- Distributed under the 3-Clause BSD licence (see the file LICENSE). import Test -import Data.List (sort)+import Data.List (sort, nub, union) +#if __GLASGOW_HASKELL__ < 710+import Data.Typeable (Typeable)+deriving instance Typeable NOrd+#endif++data NOrd = NOrd+  deriving Show++deriveListable ''NOrd+deriveGeneralizable ''NOrd++nord :: NOrd+nord = undefined+ main :: IO () main = mainTest tests 10000 @@ -83,6 +98,39 @@                                 , constant "<"  $ (<)  -:> int                                 ] +  , background (mayb int)+    == [ constant "Just" (Just ->: mayb int)+       , constant "=="   ((==) -:> mayb int)+       , constant "/="   ((/=) -:> mayb int)+       , constant "<="   ((<=) -:> mayb int)+       , constant "<"    ((<)  -:> mayb int) ]++  , background (eith int char)+    == [ constant "Left"  (Left  ->: eith int char)+       , constant "Right" (Right ->: eith int char)+       , constant "=="    ((==)  -:> eith int char)+       , constant "/="    ((/=)  -:> eith int char)+       , constant "<="    ((<=)  -:> eith int char)+       , constant "<"     ((<)   -:> eith int char) ]++  , background [int]+    == [ constant "length" (length -:> [int])+       , constant "elem"   (elem  ->:> [int])+       , constant "=="     ((==)   -:> [int])+       , constant "/="     ((/=)   -:> [int])+       , constant "<="     ((<=)   -:> [int])+       , constant "<"      ((<)    -:> [int]) ]++  , background (mayb nord)+    == [ constant "Just" (Just ->: mayb nord) ]++  , background (eith nord nord)+    == [ constant "Left"  (Left  ->: eith nord nord)+       , constant "Right" (Right ->: eith nord nord) ]++  , background [nord]+    == [ constant "length" (length -:> [nord]) ]+   -- background tests   , listBackgroundOK ()   , listBackgroundOK int@@ -138,6 +186,7 @@        , zero -:- zero -:- _is        ] +  {- TODO: fix the following tests   , candidateConditions (([int] >- bool) `With` MaxConditionSize 3) [xxs]     == [ true, elem' zero xxs ] @@ -157,6 +206,35 @@        , xx   -<=- zero        , xx   -<=- xx        ]+  -}++  , holds n $ (*==*) ==== (==) -:> int+  , holds n $ (*==*) ==== (==) -:> char+  , holds n $ (*==*) ==== (==) -:> [int]+  , holds n $ (*==*) ==== (==) -:> mayb int+  , holds n $ (*==*) ==== (==) -:> mayb char+  , holds n $ (*==*) ==== (==) -:> eith int char++  , holds n $ (*/=*) ==== (/=) -:> int+  , holds n $ (*/=*) ==== (/=) -:> char+  , holds n $ (*/=*) ==== (/=) -:> [int]+  , holds n $ (*/=*) ==== (/=) -:> mayb int+  , holds n $ (*/=*) ==== (/=) -:> mayb char+  , holds n $ (*/=*) ==== (/=) -:> eith int char++  , holds n $ (*<=*) ==== (<=) -:> int+  , holds n $ (*<=*) ==== (<=) -:> char+--, holds n $ (*<=*) ==== (<=) -:> [int]+--, holds n $ (*<=*) ==== (<=) -:> mayb int+--, holds n $ (*<=*) ==== (<=) -:> mayb char+--, holds n $ (*<=*) ==== (<=) -:> eith int char++  , holds n $ (*<*) ==== (<) -:> int+  , holds n $ (*<*) ==== (<) -:> char+--, holds n $ (*<*) ==== (<) -:> [int]+--, holds n $ (*<*) ==== (<) -:> mayb int+--, holds n $ (*<*) ==== (<) -:> mayb char+--, holds n $ (*<*) ==== (<) -:> eith int char   ]  listBackgroundOK :: Generalizable a => a -> Bool@@ -166,6 +244,6 @@                      +++ backgroundOf x  maybeBackgroundOK :: Generalizable a => a -> Bool-maybeBackgroundOK x = backgroundOf (mayb x) =$ sort $= backgroundMaybeOf x+maybeBackgroundOK x = backgroundMaybeOf x `subset` backgroundOf (mayb x)   where   backgroundMaybeOf x = [constant "Just" $ Just -:> x] +++ backgroundOf x
+ tests/test-new.hs view
@@ -0,0 +1,51 @@+-- Copyright (c) 2017 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+import Test++import Data.List (sort, nub, union)++import Test.Extrapolate.New++main :: IO ()+main = mainTest tests 10000++tests :: Int -> [Bool]+tests n =+  [ True++  -- tests about lgg+  , lggOK n int+  , lggOK n [int]+  , lggOK n [[int]]+  , lggOK n [([int],eith int char)]+  , lgg1 (expr [0,0::Int]) (expr [1,1::Int])    ==  _i -:- _i -:- ll+  , lgg1 (expr [0,1::Int]) (expr [1,0::Int])    ==  _i -:- _i -:- ll+  , lgg1 (expr [0,0::Int]) (expr [0,0,1::Int])  ==  zero -:- zero -:- _is+  , lgg1 (expr [1,1::Int]) (expr [2,2,2::Int])  ==  _i -:- _i -:- _is+  , lgg1 (expr (Just (0::Int))) (expr (Nothing :: Maybe Int)) == _mi+  , lgg1 (expr (Just (0::Int))) (expr (Just (1 :: Int)))      == just _i+  , lgg1 (expr [Just 1, Just (0::Int)]) (expr [Nothing, Just (1::Int)])+    ==  _mi -:- just _i -:- llmi++  , head (generalizedCounterExamples 360 $ \xs -> nub xs == (xs::[Int]))+    == [_i -:- _i -:- _is]+  , head (generalizedCounterExamples 360 $ \xs ys -> xs `union` ys == ys `union` (xs::[Int]))+    == [ll, zero -:- zero -:- ll]+-- but should be:+--  == [_is, _i -:- _i -:- _is]+  ]++lggOK :: Generalizable a => Int -> a -> Bool+lggOK n x = holds n (lggCommutative -:> x)+         && holds n (lggAssociative -:> x)+         && holds n (lggIdempotent -:> x)++lggCommutative :: Generalizable a => a -> a -> Bool+lggCommutative x y = lgg1 (expr x) (expr y) == lgg1 (expr y) (expr x)++lggAssociative :: Generalizable a => a -> a -> a -> Bool+lggAssociative x y z = (associative lgg1) (expr x) (expr y) (expr z)++lggIdempotent :: Generalizable a => a -> a -> Bool+lggIdempotent x y = let z = expr x `lgg1` expr y+                    in  z == (z `lgg1` expr y)
tests/test-utils.hs view
@@ -15,4 +15,40 @@   , holds n $ elemBy (==) ==== elem -:> bool   , holds n $ elemBy (==) ==== elem -:> [int]   , holds n $ elemBy (==) ==== elem -:> [bool]++  , holds n $ listEq (==) ==== (==) -:> [()]+  , holds n $ listEq (==) ==== (==) -:> [int]+  , holds n $ listEq (==) ==== (==) -:> [bool]+  , holds n $ listEq (==) ==== (==) -:> [[int]]+  , holds n $ listEq (==) ==== (==) -:> [[bool]]++  , holds n $ listOrd (<=) ==== (<=) -:> [()]+  , holds n $ listOrd (<=) ==== (<=) -:> [int]+  , holds n $ listOrd (<=) ==== (<=) -:> [bool]+  , holds n $ listOrd (<=) ==== (<=) -:> [[int]]+  , holds n $ listOrd (<=) ==== (<=) -:> [[bool]]++  , holds n $ maybeEq (==) ==== (==) -:> mayb ()+  , holds n $ maybeEq (==) ==== (==) -:> mayb int+  , holds n $ maybeEq (==) ==== (==) -:> mayb bool+  , holds n $ maybeEq (==) ==== (==) -:> mayb [int]+  , holds n $ maybeEq (==) ==== (==) -:> mayb [bool]++  , holds n $ maybeOrd (<=) ==== (<=) -:> mayb ()+  , holds n $ maybeOrd (<=) ==== (<=) -:> mayb int+  , holds n $ maybeOrd (<=) ==== (<=) -:> mayb bool+  , holds n $ maybeOrd (<=) ==== (<=) -:> mayb [int]+  , holds n $ maybeOrd (<=) ==== (<=) -:> mayb [bool]++  , holds n $ eitherEq (==) (==) ==== (==) -:> eith () ()+  , holds n $ eitherEq (==) (==) ==== (==) -:> eith int int+  , holds n $ eitherEq (==) (==) ==== (==) -:> eith int bool+  , holds n $ eitherEq (==) (==) ==== (==) -:> eith bool int+  , holds n $ eitherEq (==) (==) ==== (==) -:> eith bool bool++  , holds n $ eitherOrd (<=) (<=) ==== (<=) -:> eith () ()+  , holds n $ eitherOrd (<=) (<=) ==== (<=) -:> eith int int+  , holds n $ eitherOrd (<=) (<=) ==== (<=) -:> eith int bool+  , holds n $ eitherOrd (<=) (<=) ==== (<=) -:> eith bool int+  , holds n $ eitherOrd (<=) (<=) ==== (<=) -:> eith bool bool   ]