Exercise3.hs

module Main where

import Test.QuickCheck

-----------------------------------------------------------------------
-- 3.1 - Trivial
-----------------------------------------------------------------------

data Trivial = Trivial deriving (Eq, Show) 

instance Semigroup Trivial where
  _ <> _ = Trivial

instance Arbitrary Trivial where
  arbitrary = return Trivial

type TrivAssoc = Trivial -> Trivial -> Trivial -> Bool

-----------------------------------------------------------------------
-- 3.2 - Two a b
-----------------------------------------------------------------------

data Two a b = Two a b
  deriving (Eq, Show)

instance (Semigroup a, Semigroup b) => Semigroup (Two a b) where
  (Two a b) <> (Two a' b') = Two (a <> a') (b <> b')

type TwoAssoc a b = Two a b -> Two a b -> Two a b -> Bool

instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
  arbitrary = do
    a <- arbitrary
    b <- arbitrary
    return $ Two a b

-----------------------------------------------------------------------
-- 3.3 - BoolConj
-----------------------------------------------------------------------

newtype BoolConj = BoolConj Bool
  deriving (Eq, Show)

instance Semigroup BoolConj where
  (BoolConj a) <> (BoolConj b) = BoolConj $ a && b

type BoolConjAssoc = BoolConj -> BoolConj -> BoolConj -> Bool

instance Arbitrary BoolConj where
  arbitrary = BoolConj <$> arbitrary

-----------------------------------------------------------------------
-- Tests
-----------------------------------------------------------------------

semigroupAssoc :: (Eq m, Semigroup m) => m -> m -> m -> Bool
semigroupAssoc a b c = (a <> (b <> c)) == ((a <> b) <> c)
       
main :: IO ()
main = do
  quickCheck (semigroupAssoc :: TrivAssoc)
  quickCheck (semigroupAssoc :: TwoAssoc () ())
  quickCheck (semigroupAssoc :: BoolConjAssoc)