Merge pull request #11 from purescript/mapAccum

Add mapAccumL/R

Author: paf31

Gruntfile.js

@@ -13,7 +13,7 @@ module.exports = function(grunt) {
 
     pscMake: ["<%=libFiles%>"],
     dotPsci: ["<%=libFiles%>"],
-    docgen: {
+    pscDocs: {
         readme: {
             src: "src/**/*.purs",
             dest: "README.md"
@@ -25,6 +25,6 @@ module.exports = function(grunt) {
   grunt.loadNpmTasks("grunt-contrib-clean");
   grunt.loadNpmTasks("grunt-purescript");
 
-  grunt.registerTask("make", ["pscMake", "dotPsci", "docgen"]);
+  grunt.registerTask("make", ["pscMake", "dotPsci", "pscDocs"]);
   grunt.registerTask("default", ["make"]);
 };

README.md

@@ -64,6 +64,9 @@
 
 ## Module Data.Traversable
 
+### Types
+
+
 ### Type Classes
 
     class (Functor t, Foldable t) <= Traversable t where
@@ -73,6 +76,18 @@
 
 ### Type Class Instances
 
+    instance applicativeStateL :: Applicative (StateL s)
+
+    instance applicativeStateR :: Applicative (StateR s)
+
+    instance applyStateL :: Apply (StateL s)
+
+    instance applyStateR :: Apply (StateR s)
+
+    instance functorStateL :: Functor (StateL s)
+
+    instance functorStateR :: Functor (StateR s)
+
     instance traversableArray :: Traversable Prim.Array
 
     instance traversableEither :: Traversable (Either a)
@@ -88,4 +103,8 @@
 
     for :: forall a b m t. (Applicative m, Traversable t) => t a -> (a -> m b) -> m (t b)
 
+    mapAccumL :: forall a b s f. (Traversable f) => (s -> a -> Tuple s b) -> s -> f a -> Tuple s (f b)
+
+    mapAccumR :: forall a b s f. (Traversable f) => (s -> a -> Tuple s b) -> s -> f a -> Tuple s (f b)
+
     zipWithA :: forall m a b c. (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c]

package.json

@@ -2,7 +2,7 @@
   "private": true,
   "dependencies": {
     "grunt": "~0.4.4",
-    "grunt-purescript": "~0.5.1",
+    "grunt-purescript": "~0.6.0",
     "grunt-contrib-clean": "~0.5.0"
   }
 }

src/Data/Traversable.purs

@@ -1,4 +1,12 @@
-module Data.Traversable where
+module Data.Traversable 
+  ( Traversable
+  , traverse
+  , sequence
+  , for
+  , zipWithA
+  , mapAccumL
+  , mapAccumR
+  ) where
 
 import Prelude
 import Data.Array (zipWith)
@@ -49,3 +57,43 @@ for x f = traverse f x
 zipWithA :: forall m a b c. (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
 zipWithA f xs ys = sequence (zipWith f xs ys)
 
+newtype StateL s a = StateL (s -> Tuple s a)
+
+stateL :: forall s a. StateL s a -> s -> Tuple s a
+stateL (StateL k) = k
+
+instance functorStateL :: Functor (StateL s) where
+  (<$>) f k = StateL $ \s -> case stateL k s of
+    Tuple s1 a -> Tuple s1 (f a)
+
+instance applyStateL :: Apply (StateL s) where
+  (<*>) f x = StateL $ \s -> case stateL f s of
+    Tuple s1 f' -> case stateL x s1 of
+      Tuple s2 x' -> Tuple s2 (f' x')
+
+instance applicativeStateL :: Applicative (StateL s) where
+  pure a = StateL $ \s -> Tuple s a
+
+mapAccumL :: forall a b s f. (Traversable f) => (s -> a -> Tuple s b) -> s -> f a -> Tuple s (f b)
+mapAccumL f s0 xs = stateL (traverse (\a -> StateL $ \s -> f s a) xs) s0
+
+newtype StateR s a = StateR (s -> Tuple s a)
+
+stateR :: forall s a. StateR s a -> s -> Tuple s a
+stateR (StateR k) = k
+
+instance functorStateR :: Functor (StateR s) where
+  (<$>) f k = StateR $ \s -> case stateR k s of
+    Tuple s1 a -> Tuple s1 (f a)
+                                            
+instance applyStateR :: Apply (StateR s) where
+  (<*>) f x = StateR $ \s -> case stateR x s of
+    Tuple s1 x' -> case stateR f s1 of
+      Tuple s2 f' -> Tuple s2 (f' x')
+
+instance applicativeStateR :: Applicative (StateR s) where
+  pure a = StateR $ \s -> Tuple s a
+
+mapAccumR :: forall a b s f. (Traversable f) => (s -> a -> Tuple s b) -> s -> f a -> Tuple s (f b)
+mapAccumR f s0 xs = stateR (traverse (\a -> StateR $ \s -> f s a) xs) s0
+