From c6148c6cad3f5322ab5a6bcc54f6319fb1815859 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 21 Mar 2018 17:16:09 -0400 Subject: [PATCH] Test the associativity of the semigroup instances. --- src/Data/Semigroup/App.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/Data/Semigroup/App.hs b/src/Data/Semigroup/App.hs index 414ce1c9b..78922f68c 100644 --- a/src/Data/Semigroup/App.hs +++ b/src/Data/Semigroup/App.hs @@ -7,10 +7,17 @@ module Data.Semigroup.App import Control.Applicative import Data.Semigroup +-- $setup +-- >>> import Test.QuickCheck +-- >>> instance Arbitrary (f a) => Arbitrary (App f a) where arbitrary = App <$> arbitrary +-- >>> instance Arbitrary (f a) => Arbitrary (AppMerge f a) where arbitrary = AppMerge <$> arbitrary + -- | 'Semigroup' under '<*>' and '<>'. newtype AppMerge f a = AppMerge { runAppMerge :: f a } deriving (Alternative, Applicative, Bounded, Enum, Eq, Foldable, Functor, Monad, Ord, Show, Traversable) +-- $ Associativity: +-- prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: AppMerge Maybe String) instance (Applicative f, Semigroup a) => Semigroup (AppMerge f a) where AppMerge a <> AppMerge b = AppMerge ((<>) <$> a <*> b) @@ -23,6 +30,8 @@ instance (Applicative f, Monoid a, Semigroup a) => Monoid (AppMerge f a) where newtype App f a = App { runApp :: f a } deriving (Alternative, Applicative, Bounded, Enum, Eq, Foldable, Functor, Monad, Ord, Show, Traversable) +-- $ Associativity: +-- prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: App Maybe Integer) instance Applicative f => Semigroup (App f a) where App a <> App b = App (a *> b)