chapter 15: added exercise 12 for semigroup on AccumulateRight. Which implements a new semigroup instance for Validtion type

Author: mukeshsoni

chapter15/exercises/semigroup/11_validation.hs

@@ -1,23 +1,23 @@
-import Test.QuickCheck
-import Data.Semigroup
-import SemigroupLaws
+import Test.QuickCheck (arbitrary, Arbitrary, quickCheck, oneof)
+import Data.Semigroup (Semigroup, (<>))
+import SemigroupLaws 
 
 data Validation a b =
-    Failure' a | Success' b
+    Failure a | Success b
     deriving (Eq, Show)
 
 instance Semigroup a =>
     Semigroup (Validation a b) where
-        (Success' a) <> (Success' b) = Success' b
-        (Failure' a) <> (Failure' b) = Failure' (a <> b)
-        (Failure' a) <> (Success' b) = Failure' a
-        (Success' a) <> (Failure' b) = Failure' b
+        (Success a) <> (Success b) = Success b
+        (Failure a) <> (Failure b) = Failure (a <> b)
+        (Failure a) <> (Success b) = Failure a
+        (Success a) <> (Failure b) = Failure b
 
 instance (Arbitrary a, Arbitrary b) => Arbitrary (Validation a b) where
     arbitrary = do
         x <- arbitrary
         y <- arbitrary
-        oneof [return (Success' x), return (Failure' y)]
+        oneof [return (Success x), return (Failure y)]
 
 type ValidationAssoc = Validation String String -> Validation String String -> Validation String String -> Bool
 type ValidationAssoc2 = Validation String Integer -> Validation String Integer -> Validation String Integer -> Bool

chapter15/exercises/semigroup/12_accumulate_right.hs

@@ -0,0 +1,31 @@
+import Test.QuickCheck (arbitrary, Arbitrary, quickCheck, oneof)
+import Data.Semigroup (Semigroup, (<>))
+import SemigroupLaws 
+
+data Validation a b =
+    Failure a | Success b
+    deriving (Eq, Show)
+
+newtype AccumulateRight a b =
+    AccumulateRight (Validation a b)
+    deriving (Eq, Show)
+
+instance Semigroup a =>
+    Semigroup (AccumulateRight a b) where
+        (AccumulateRight (Success _)) <> (AccumulateRight (Success b)) = AccumulateRight (Success b)
+        (AccumulateRight (Failure _)) <> (AccumulateRight (Failure b)) = AccumulateRight (Failure b)
+        (AccumulateRight (Failure a)) <> (AccumulateRight (Success _)) = AccumulateRight (Failure a)
+        (AccumulateRight (Success _)) <> (AccumulateRight (Failure b)) = AccumulateRight (Failure b)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (AccumulateRight a b) where
+    arbitrary = do
+        x <- arbitrary
+        y <- arbitrary
+        oneof [return (AccumulateRight (Success x)), return (AccumulateRight (Failure y))]
+
+type ValidationAssoc = AccumulateRight String String -> AccumulateRight String String -> AccumulateRight String String -> Bool
+type ValidationAssoc2 = AccumulateRight String Integer -> AccumulateRight String Integer -> AccumulateRight String Integer -> Bool
+
+main = do
+    quickCheck (assocLaw :: ValidationAssoc)
+    quickCheck (assocLaw :: ValidationAssoc2)