Semigroup Laws

stack.yaml

resolver:
  lts-11.22

extra-deps:
  - hedgehog-0.6.1

test.hs

-- | https://stackoverflow.com/q/52627561/467754
--
{-# LANGUAGE OverloadedStrings #-}

import           Data.Monoid    (Sum (..))
import           Data.Semigroup (Semigroup ((<>)))

import           Hedgehog
import qualified Hedgehog.Gen   as Gen
import qualified Hedgehog.Range as Range

import           Control.Monad  (unless)
import           System.Exit    (exitFailure)

associativity :: (Eq m, Show m, Semigroup m) => Gen m -> Property
associativity g =
  property $ do
    x <- forAll g
    y <- forAll g
    z <- forAll g
    (x <> y) <> z === x <> (y <> z)

monoidLaws :: Group
monoidLaws =
  Group "Monoid laws" [
      ("Associativity law, [Int]"
      , associativity $ Gen.list (Range.linear 0 100) (Gen.int Range.constantBounded)
      )
    , ("Associativity law, Sum Int"
      , associativity $ Sum <$> Gen.int Range.constantBounded
      )
    ]

main :: IO ()
main = do
  results <- sequence [
      checkParallel $ monoidLaws
    ]

  unless (and results) $
    exitFailure

-- | ━━━ Monoid laws ━━━
--     ✓ Associativity law, [Int] passed 100 tests.
--     ✓ Associativity law, Sum Int passed 100 tests.
--     ✓ 2 succeeded.