Don’t ignore mappend failures in validation

Previously, a <> b would give success if either a or b were a success!
This should not happen when doing validation. We want any errors to be
propagated.

Fixes #35

src/Data/Validation.hs

@@ -164,10 +164,10 @@ appValidation ::
   -> Validation err a
 appValidation m (Failure e1) (Failure e2) =
   Failure (e1 `m` e2)
-appValidation _ (Failure _) (Success a2) =
-  Success a2
-appValidation _ (Success a1) (Failure _) =
-  Success a1
+appValidation _ (Failure e1) (Success _) =
+  Failure e1
+appValidation _ (Success _) (Failure e2) =
+  Failure e2
 appValidation _ (Success a1) (Success _) =
   Success a1
 {-# INLINE appValidation #-}

test/hunit_tests.hs

@@ -111,6 +111,38 @@ testValidateNothing =
       option = Nothing :: Maybe Int
   in  TestCase (assertEqual "testValidateFalse" subject expected)
 
+testMappendNY :: Test
+testMappendNY =
+  let v1 = _Failure # [three]
+      v2 = _Success # [seven]
+      subject = v1 <> v2
+      expected = Failure [three]
+  in  TestCase (assertEqual "Failure <> Success" subject expected)
+
+testMappendYN :: Test
+testMappendYN =
+  let v1 = _Success # [three]
+      v2 = _Failure # [seven]
+      subject = v1 <> v2
+      expected = Failure [seven]
+  in  TestCase (assertEqual "Success <> Failure" subject expected)
+
+testMappendYY :: Test
+testMappendYY =
+  let v1 = _Success # [three]
+      v2 = _Success # [seven]
+      subject = v1 <> v2 :: Validation [Int] [Int]
+      expected = Success [three]
+  in  TestCase (assertEqual "Success <> Success" subject expected)
+
+testMappendNN :: Test
+testMappendNN =
+  let v1 = _Failure # [three]
+      v2 = _Failure # [seven]
+      subject = v1 <> v2 :: Validation [Int] [Int]
+      expected = Failure [three, seven]
+  in  TestCase (assertEqual "Failure <> Failure" subject expected)
+
 tests :: Test
 tests =
   let eitherP :: Proxy Either
@@ -138,6 +170,10 @@ tests =
   , testValidateNothing
   , testValidateJust
   , testValidateJust'
+  , testMappendNY
+  , testMappendYY
+  , testMappendNN
+  , testMappendYN
   ] ++ eithers ++ validations
   where