Merge pull request #15 from purescript/f-t

Add Foldable and Traversable instances for V

Author: garyb

.gitignore

@@ -1,6 +1,7 @@
 /.*
 !/.gitignore
 !/.travis.yml
+package-lock.json
 /bower_components/
 /node_modules/
 /output/

bower.json

@@ -18,6 +18,7 @@
   ],
   "dependencies": {
     "purescript-bifunctors": "^3.0.0",
-    "purescript-monoid": "^3.0.0"
+    "purescript-monoid": "^3.0.0",
+    "purescript-foldable-traversable": "^3.6.1"
   }
 }

src/Data/Validation/Semigroup.purs

@@ -14,9 +14,10 @@ module Data.Validation.Semigroup
 import Prelude
 
 import Control.Apply (lift2)
-
 import Data.Bifunctor (class Bifunctor)
+import Data.Foldable (class Foldable)
 import Data.Monoid (class Monoid, mempty)
+import Data.Traversable (class Traversable)
 
 -- | The `V` functor, used for applicative validation
 -- |
@@ -79,3 +80,12 @@ instance semigroupV :: (Semigroup err, Semigroup a) => Semigroup (V err a) where
 
 instance monoidV :: (Semigroup err, Monoid a) => Monoid (V err a) where
   mempty = pure mempty
+
+instance foldableV :: Foldable (V err) where
+  foldMap = unV (const mempty)
+  foldr f b = unV (const b) (flip f b)
+  foldl f b = unV (const b) (f b)
+
+instance traversableV :: Traversable (V err) where
+  sequence = unV (pure <<< Invalid) (map Valid)
+  traverse f = unV (pure <<< Invalid) (map Valid <<< f)

src/Data/Validation/Semiring.purs

@@ -14,12 +14,13 @@ module Data.Validation.Semiring
 import Prelude
 
 import Control.Alt (class Alt)
+import Control.Alternative (class Alternative)
 import Control.Apply (lift2)
 import Control.Plus (class Plus)
-import Control.Alternative (class Alternative)
-
 import Data.Bifunctor (class Bifunctor)
+import Data.Foldable (class Foldable)
 import Data.Monoid (class Monoid, mempty)
+import Data.Traversable (class Traversable)
 
 -- | The `V` functor, used for alternative validation
 -- |
@@ -94,3 +95,12 @@ instance plusV :: (Semiring err) => Plus (V err) where
   empty = Invalid zero
 
 instance alernativeV :: (Semiring err) => Alternative (V err)
+
+instance foldableV :: Foldable (V err) where
+  foldMap = unV (const mempty)
+  foldr f b = unV (const b) (flip f b)
+  foldl f b = unV (const b) (f b)
+
+instance traversableV :: Traversable (V err) where
+  sequence = unV (pure <<< Invalid) (map Valid)
+  traverse f = unV (pure <<< Invalid) (map Valid <<< f)