Cabal-tests/tests/Test/Laws.hs

   1 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   2 module Test.Laws where
   3
   4 import Prelude hiding (Num((+), (*)))
   5 import Data.Monoid (Monoid(..), Endo(..))
   6 import qualified Data.Foldable as Foldable
   7
   8 idempotent_unary  f x = f fx == fx where fx = f x
   9
  10 -- Basic laws on binary operators
  11
  12 idempotent_binary (+) x = x + x == x
  13
  14 commutative (+) x y = x + y == y + x
  15
  16 associative (+) x y z = (x + y) + z ==  x + (y + z)
  17
  18 distributive_left  (*) (+) x y z = x * (y + z) == (x * y) + (x * z)
  19
  20 distributive_right (*) (+) x y z = (y + z) * x == (y * x) + (z * x)
  21
  22
  23 -- | The first 'fmap' law
  24 --
  25 -- > fmap id  ==  id
  26 --
  27 fmap_1 :: (Eq (f a), Functor f) => f a -> Bool
  28 fmap_1 x = fmap id x == x
  29
  30 -- | The second 'fmap' law
  31 --
  32 -- > fmap (f . g)  ==  fmap f . fmap g
  33 --
  34 fmap_2 :: (Eq (f c), Functor f) => (b -> c) -> (a -> b) -> f a -> Bool
  35 fmap_2 f g x = fmap (f . g) x == (fmap f . fmap g) x
  36
  37
  38 -- | The monoid identity law, 'mempty' is a left and right identity of
  39 -- 'mappend':
  40 --
  41 -- > mempty `mappend` x = x
  42 -- > x `mappend` mempty = x
  43 --
  44 monoid_1 :: (Eq a, Data.Monoid.Monoid a) => a -> Bool
  45 monoid_1 x = mempty `mappend` x == x
  46           && x `mappend` mempty == x
  47
  48 -- | The monoid associativity law, 'mappend' must be associative.
  49 --
  50 -- > (x `mappend` y) `mappend` z = x `mappend` (y `mappend` z)
  51 --
  52 monoid_2 :: (Eq a, Data.Monoid.Monoid a) => a -> a -> a -> Bool
  53 monoid_2 x y z = (x `mappend`  y) `mappend` z
  54               ==  x `mappend` (y  `mappend` z)
  55
  56 -- | The 'mconcat' definition. It can be overridden for the sake of efficiency
  57 -- but it must still satisfy the property given by the default definition:
  58 --
  59 -- > mconcat = foldr mappend mempty
  60 --
  61 monoid_3 :: (Eq a, Data.Monoid.Monoid a) => [a] -> Bool
  62 monoid_3 xs = mconcat xs == foldr mappend mempty xs
  63
  64
  65 -- | First 'Foldable' law
  66 --
  67 -- > Foldable.fold = Foldable.foldr mappend mempty
  68 --
  69 foldable_1 :: (Foldable.Foldable t, Monoid m, Eq m) => t m -> Bool
  70 foldable_1 x = Foldable.fold x == Foldable.foldr mappend mempty x
  71
  72 -- | Second 'Foldable' law
  73 --
  74 -- > foldr f z t = appEndo (foldMap (Endo . f) t) z
  75 --
  76 foldable_2 :: (Foldable.Foldable t, Eq b)
  77                => (a -> b -> b) -> b -> t a -> Bool
  78 foldable_2 f z t = Foldable.foldr f z t
  79                     == appEndo (Foldable.foldMap (Endo . f) t) z