Solution for Ch15 Combine type - Proving that Combine is a monoid

combine.hs

newtype Combine a b =
  Combine { unCombine :: (a -> b) }
-- example usage
-- > let f = Combine $ \n -> Sum (n + 1)
-- > unCombine f $ 1
-- 2

-- dummy show instance so quickCheck works
instance Show (Combine a b) where
  show (Combine f) = "Combine instance"

-- monoid instance for Combine
instance Monoid b => Monoid (Combine a b) where
  mempty = Combine (const mempty)

-- semigroup definition for Combine
instance Semigroup b => Semigroup (Combine a b) where
  (Combine a) <> (Combine a') = Combine (\x -> a x <> a' x)

-- function asserting associative property for Combine
combineAssoc :: (Eq b, Semigroup b)
             => a
             -> Combine a b
             -> Combine a b
             -> Combine a b
             -> Bool
combineAssoc v f g h =
  (unCombine (f <> (g <> h)) $ v) == (unCombine ((f <> g) <> h) $ v)

-- Arbitrary instance for Combine
instance (CoArbitrary a, Arbitrary b) => Arbitrary (Combine a b) where
  arbitrary = Combine <$> arbitrary

-- Helper type for brevity when defining what we give to quickCheck
type CombineString = Combine String String

-- what we give to quickCheck when proving combine associativity
type CombineStringAssoc =
  String -> CombineString -> CombineString -> CombineString -> Bool

-- function asserting left identity for Combine
combineLeftIdentity :: (Eq b, Monoid b)
                    => a
                    -> Combine a b
                    -> Bool
combineLeftIdentity v f = (unCombine (mempty <> f) $ v) == (unCombine f $ v)

-- function asserting right identity for Combine
combineRightIdentity :: (Eq b, Monoid b)
                     => a
                     -> Combine a b
                     -> Bool
combineRightIdentity v f = (unCombine (f <> mempty) $ v) == (unCombine f $ v)

-- proving that Combine is a Monoid
checkCombine :: IO ()
checkCombine = do
  quickCheck (combineAssoc :: CombineStringAssoc)
  quickCheck (combineLeftIdentity :: String -> CombineString -> Bool)
  quickCheck (combineRightIdentity :: String -> CombineString -> Bool)