@@ -49,3 +49,43 @@ for x f = traverse f x
4949zipWithA :: forall m a b c . (Applicative m ) => (a -> b -> m c ) -> [a ] -> [b ] -> m [c ]
5050zipWithA f xs ys = sequence (zipWith f xs ys)
5151
52+ newtype StateL s a = StateL (s -> Tuple s a )
53+
54+ stateL :: forall s a . StateL s a -> s -> Tuple s a
55+ stateL (StateL k) = k
56+
57+ instance functorStateL :: Functor (StateL s ) where
58+ (<$>) f k = StateL $ \s -> case stateL k s of
59+ Tuple s1 a -> Tuple s1 (f a)
60+
61+ instance applyStateL :: Apply (StateL s ) where
62+ (<*>) f x = StateL $ \s -> case stateL f s of
63+ Tuple s1 f' -> case stateL x s1 of
64+ Tuple s2 x' -> Tuple s2 (f' x')
65+
66+ instance applicativeStateL :: Applicative (StateL s ) where
67+ pure a = StateL $ \s -> Tuple s a
68+
69+ mapAccumL :: forall a b s f . (Traversable f ) => (s -> a -> Tuple s b ) -> s -> f a -> Tuple s (f b )
70+ mapAccumL f s0 xs = stateL (traverse (\a -> StateL $ \s -> f s a) xs) s0
71+
72+ newtype StateR s a = StateR (s -> Tuple s a )
73+
74+ stateR :: forall s a . StateR s a -> s -> Tuple s a
75+ stateR (StateR k) = k
76+
77+ instance functorStateR :: Functor (StateR s ) where
78+ (<$>) f k = StateR $ \s -> case stateR k s of
79+ Tuple s1 a -> Tuple s1 (f a)
80+
81+ instance applyStateR :: Apply (StateR s ) where
82+ (<*>) f x = StateR $ \s -> case stateR x s of
83+ Tuple s1 x' -> case stateR f s1 of
84+ Tuple s2 f' -> Tuple s2 (f' x')
85+
86+ instance applicativeStateR :: Applicative (StateR s ) where
87+ pure a = StateR $ \s -> Tuple s a
88+
89+ mapAccumR :: forall a b s f . (Traversable f ) => (s -> a -> Tuple s b ) -> s -> f a -> Tuple s (f b )
90+ mapAccumR f s0 xs = stateR (traverse (\a -> StateR $ \s -> f s a) xs) s0
91+
0 commit comments